I'm trying to analyze some data from a worksheet, the first step was to find the last row, which I managed. Then I need to store the data in an array for each column to simplify further analysis.
My data looks like this:
I'm trying to store let's say the B column in an array but starting at B6:
Sub List_Rem_stock()
Dim array_Rem_Batch(1 To last_row_Rem_stock - 5) As Integer
For i = 1 To last_row_Rem_stock - 5
array_Rem_Batch(i) = Worksheets("Rem stock").Range(Bi)
Next i
Debug.Print array_Rem_Index
End Sub
last_row_Rem_stock represents the last row of the table.
Am I doing this properly?
Almost, try the code below (find explanation inside code's comments):
Option Explicit
Sub List_Rem_stock()
Dim last_row_Rem_stock As Long, i As Long
Dim array_Rem_Batch() As Long
With Worksheets("Rem stock")
last_row_Rem_stock = .Cells(.Rows.Count, "B").End(xlUp).Row ' get last row with value in colum B
ReDim array_Rem_Batch(1 To last_row_Rem_stock - 5) ' redim array size
For i = 1 To last_row_Rem_stock - 5
array_Rem_Batch(i) = .Range("B" & i).Value
Next i
End With
End Sub
You can allocate a range to an array (2D) as such:
Dim arrData as variant: arrData = Range("B1:B" & lastrow).
You can also put the array back on the spreadsheet the same way:
Range("B1:B" & lastrow) = arrData
Simple, easy and fast, without the need of iterating through data.
In your example, you would probably do it like this.
Sub List_Rem_stock()
Dim i As Long, last_row_Rem_stock As Long
Dim array_Rem_Batch As Variant
With Worksheets("Rem stock")
last_row_Rem_stock = .Cells(.Rows.Count, "B").End(xlUp).Row 'get last row in B
array_Rem_Batch = .Range("B1:B" & last_row_Rem_stock)
End With
For i = 6 To last_row_Rem_stock
Debug.Print array_Rem_Batch(i, 1)
Next i
End Sub
To note that arrays allocated this way will always start at 1, not 0.
EDIT:
I'm allocating the data starting at row 1, and not at row 6, purely for the nice 1:1 relation between array index and sheet rows. Is my prefered way, wherever the situation allows.
If array_Rem_Batch(i, 1) = Range("B" & i) Then ....
Can always allocate the data from any row you want:
array_Rem_Batch = Worksheets("Rem stock").Range("B6:B100") 'now the array has 95 rows.
In this case, array index 1, will corespond to row 6 in the sheet, and will have to manage this in the code if you need to something like this:
If array_Rem_Batch(i, 1) = Range("B" & i + 5) Then ....
Related
i have a multidimensional dynamic array with 11 columns.
how do i count how many elements in column 4 starts with "ZS" (there can be items with no value, other with "ZC973279473" and others with "ZS5367276". i care only about the one like "ZS773746".)
i tried with
XNSites = Application.Count(Application.Match(Left(myarray.Columns(4), 2), "ZS", 0))
and
XNSites = Application.WorksheetFunction.CountIf(Left(myarray.columns(4), 2), "=" & "ZS")
but it doesn't work
Since your data seems to be alphanumeric, with just the first two chars as letters, you could prevent a loop using a 1D-array extract from a 2D-array when you apply FILTER:
Sub Test()
Dim arr1 As Variant, arr2 As Variant, arr3 As Variant
Dim lr As Long
With Sheet1 'Change to your own sheets CodeName
'Fill dynamic 2D-array for testing (not sure how you get your array)
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
arr1 = .Range("A1:K" & lr).Value2
'Get you 1D-array for the 4th column
With Application
arr2 = .Transpose(.Index(arr1, 0, 4))
End With
'Count elements starting with ZS
arr3 = Filter(arr2, "ZS")
Debug.Print UBound(arr3) + 1
End With
End Sub
I think a simple iteration will help you:
Dim Count As Long
Dim ColCell As Range
For Each ColCell In myarray.Columns(11).Cells
If Left(ColCell.Value, 2) = "ZS" Then
Count = Count + 1
End If
Next ColCell
Debug.Print "Total: " & Count
Please try below code( I believe all you care about values in column 4). This code will
copy the entire rows which have ZS values at the beginning in column 4 and paste it on sheet2
If data is not on sheet1,please change the sheetname :)
Sub you()
lfr = ThisWorkbook.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lfr
If Worksheets("sheet1").Cells(x,4).Value Like "ZS*" Then
Worksheets("sheet1").Rows(x).Copy
Worksheets("sheet2").Activate
bfr = ThisWorkbook.Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("sheet2").Cells(bfr + 1, 1).Select
ActiveSheet.Paste
End If
Next
Application.CutCopyMode = False
Worksheets("sheet1").Activate
Worksheets("sheet1").Cells(1, 1).Select
End Sub
If you want just the count try below(You please change rahge from gi to wherever you want the count number) :-
Sub you()
lfr = ThisWorkbook.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lfr
KLA = Application.WorksheetFunction.Count(Worksheets("sheet1").Cells(x, 4).Value Like "ZS")
Range("g1") = KLA
Next
End Sub
I’m in a situation where I need to reproduce something in VBA and a bit stuck given my lack of understanding of object oriented language and VBA in general.
Problem:
I need to produce an array or vector based on a 2 column table.
The first range (column) contains unit counts.
The second range (column) contains numeric values.
I need to replicate the value based on the number of units.
For example,
if the first row contains 3 units with a value of $100
I need the array to contain $100, $100, $100.
This will need to be looped thru each row containing units.
So if row 2 contains 2 units with a value of $50
I need to complete array to be $100, $100, $100, $50, $50, and so on.
I understand this situation will require ReDim the array based on the total values. My struggle is I’ve been unable to figure out the nested for loops.
I get how to replicate the value based on the number of “units” like the below...
ReDim arr(0 To x - 1)
For i = 0 To x - 1
arr(i) = rng.Offset(0, 1).Value
Next
What is the best way to loop thru each row and replicate the values for each row in the range based on the unit count?
If anyone is familiar with R, I'm essentially looking for something that achieves the rep() function (e.g., rep(df$b, df$a)) and return the values in a single array.
Any help is greatly appreciated. Thanks
Or a one liner which uses the REPT function as you would have used in r :)
This assumes your data is in A1:B10 - the length can be made variable
s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
An an example, to dump the new to array to C1
s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
[c1].Resize(UBound(s), 1) = Application.Transpose(s)
When you say Row contains 3 units, do you mean the cell has value 3 or 3 Units? If it is 3 then you may not have to Redim the array in the loop. Simply find the sum of values in Col A which has units and Redim it in one go as shown below.
Sub Sample()
Dim ws As Worksheet
Dim Ar() As String
Dim n As Long, i As Long, lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet6
With ws
n = Application.WorksheetFunction.Sum(.Columns(1))
ReDim Ar(t To n)
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
n = 1
For i = 1 To lRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
For j = 1 To .Range("A" & i).Value
Ar(n) = .Range("B" & i).Value
n = n + 1
Next j
End If
Next i
For i = LBound(Ar) To UBound(Ar)
Debug.Print Ar(i)
Next i
End With
End Sub
Screenshot
And if the cell has 3 Units then you will have to store the values of Col A in an array, do a replace on Unit/Units, find the sum and finally use the above code. Here is an example
Sub Sample()
Dim ws As Worksheet
Dim Ar() As String, tmpAr As Variant
Dim n As Long, i As Long, j As Long, k As Long, lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet6
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
tmpAr = .Range("A1:A" & lRow).Value
For i = LBound(tmpAr) To UBound(tmpAr)
tmpAr(i, 1) = Replace(tmpAr(i, 1), "Units", "")
tmpAr(i, 1) = Trim(Replace(tmpAr(i, 1), "Unit", ""))
n = n + Val(tmpAr(i, 1))
Next i
ReDim Ar(t To n)
n = 1
For i = 1 To lRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
k = Val(Trim(Replace(Replace(.Range("A" & i).Value, "Units", ""), "Unit", "")))
For j = 1 To k
Ar(n) = .Range("B" & i).Value
n = n + 1
Next j
End If
Next i
For i = 1 To UBound(Ar)
Debug.Print Ar(i)
Next i
End With
End Sub
Screenshot
if your data is already in an array then ReDim'ing will delete it's contents. You can ReDim Preserve but it's an expensive operation, better to create a new array to put the results into.
I have assumed the data is contained within a Named Range called "Data" with Units being the first column and Values being the second column.
if your data changes regularly you can create a dynamic range using the OFFSET function i.e. =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),2) assuming your data starts in cell A1 and there is no header row.
Sub ProcessData()
Dim DataArr() As Variant
Dim QtyColArr() As Variant
Dim ResultArr() As Variant
Dim TotalQty As Long
Dim i As Long, j As Long, k As Long
'store data into array
DataArr = Range("Data") 'assume data stored in named range called "Data"
'store Qty col into 1D array
QtyColArr = Range("Data").Resize(, 1)
'sum all qty vals
TotalQty = Application.Sum(QtyColArr)
're-size ResultsArray
ReDim ResultArr(1 To TotalQty)
'Initialize ResultsArr counter
k = LBound(ResultArr)
'loop DataArr
For i = LBound(DataArr) To UBound(DataArr)
'loop qty for current row
For j = 1 To DataArr(i, 1)
'copy value
ResultArr(k) = DataArr(i, 2)
'iterate ResultsArr counter
k = k + 1
Next j
Next i
'output to intermediate window
Debug.Print "{" & Join(ResultArr) & "}"
End Sub
I have an excel sheet that is formatted like so:
I would like to format it to be something like this:
It is about 40,000 cells of information, so is there any way to do this that isn't manually?
You could probably use =SUMIF to achieve this, since you appear to have numbers as values.
Create a new sheet, copy column A from your data sheet to your new sheet and remove duplicates. Copy row 1 from your data sheet to your new sheet.
Use this formula in sheet 2 cell B2:
=SUMIF(Sheet1!$A:$A;Sheet2!$A2;Sheet1!B:B)
Drag the formula to the right, then down.
I am by no means an excel expert, and this is going to be my first answer ever. Take this into account please.
I've checked it and it works.
I've add a command button in Sheet1 (where the original data is), and when clicked this code writes formatted data into Sheet2.
No need to manually remove duplicates!
Dim dU1 As Object, cU1 As Variant, iU1 As Long, lrU As Long
Dim MyArray() As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim h As Integer
Private Sub CommandButton1_Click()
'Get unique indexes
Set dU1 = CreateObject("Scripting.Dictionary")
lrU = Cells(Rows.Count, 1).End(xlUp).Row 'number of rows
cU1 = Range("A2:A" & lrU) 'Assuming your data starts in A2
For iU1 = 1 To UBound(cU1, 1)
dU1(cU1(iU1, 1)) = 1
Next iU1
'Now dU1 contains indexes as unique values (about, absence, etc.)
For i = 0 To dU1.Count - 1 'for each index
ReDim MyArray(1 To 1) As Variant 'starts a "new" array
For j = 2 To 9 'each of the columns with values (D1-D8)
a = 0
For k = 2 To lrU 'all rows
If (Worksheets("Sheet1").Cells(k, 1).Value = dU1.keys()(i) And Worksheets("Sheet1").Cells(k, j).Value <> "") Then
MyArray(UBound(MyArray)) = Worksheets("Sheet1").Cells(k, j).Value 'add value to array
ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'resize array (now is 1 element longer)
a = a + 1
End If
Next
If a = 0 Then 'if no value found, add an element to array anyway
MyArray(UBound(MyArray)) = "" 'add value to array
ReDim Preserve MyArray(1 To UBound(MyArray) + 1) As Variant 'resize array (now is 1 element longer)
End If
Next
Worksheets("Sheet2").Cells(i + 2, 1) = dU1.keys()(i) 'write indexes in another sheet
For h = 2 To UBound(MyArray)
Worksheets("Sheet2").Cells(i + 2, h) = MyArray(h - 1)
Next
Next
End Sub
Just a quick question regarding VBA. I have this block of code
Dim colEmployees As New Collection
Dim recEmployee As New clsEmployee
Dim LastRow As Integer, myCount As Integer
Dim EmpArray As Variant
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
EmpArray = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 4))
and this on the spreadsheet...
now i have done a lot of reading to grasp how array are working and i have seen exaples like
Dim myArray As Variant
Dim myArray (1 to 10, 1 to 20)
myArray = Array(“Name”, “Address”, “Phone”, “Email”)
and i totally understand them but when you have an array equaled like this
EmpArray = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 4))
How can you actually save the data in a one dimensional Array such as EmpArray? Don't you need one dimension for Rows and one for Columns? I mean how the array will actually store the data-by what order ("Tracy", "Bill", "1651", "1509",....) or ("Tracy", "1651", "25", "45")? Generally storing Ranges in Arrays especially one-dimension ones looks really odd to me. And 3 of my VBA books don't delve to this a little deeper...
If it is a 2-dimensional Array how is it posible that the code continues like:
Sub EmpPayCollection()
Dim colEmployees As New Collection
Dim recEmployee As New clsEmployee
Dim LastRow As Integer, myCount As Integer
Dim EmpArray As Variant
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
EmpArray = ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 4))
For myCount = 1 To **UBound(EmpArray)**
Set recEmployee = New clsEmployee
With recEmployee
.EmpName = EmpArray(myCount, 1)
.EmpID = EmpArray(myCount, 2)
.EmpRate = EmpArray(myCount, 3)
.EmpWeeklyHrs = EmpArray(myCount, 4)
colEmployees.Add recEmployee, .EmpID
End With
Next myCount
MsgBox “Number of Employees: “ & colEmployees.Count & Chr(10) & _
“Employee(2) Name: “ & colEmployees(2).EmpName
MsgBox “Tracy’s Weekly Pay: $” & colEmployees(“1651”).EmpWeeklyPay
Set recEmployee = Nothing
End Sub
How come it use UBound without clearly stating the dimension picked? I know it is optional... but could you factor also this in to your answer...?
It doesn't store the data as a single dimensioned array, it stores it as a 2-dimensional 1 based array. The value property of a range (which contains multiple cells) returns a 2-dimensional array (value is implicit here since it is the default property of a range). In your example, the array therefore looks like:
Tracy 1651 25 45
Bill 1509 25 50
With the first dimension specifying the row and the second the column - like the cell object.
Does that answer your question?
Im coming from a Unix world where I never had to develop something for Office with VBA, I have to do some now and Im having a hard time! Please help me! :)
So I've got 2 Excel Sheets(lets call them Sheet1 and Sheet2) and 2 forms(Form1 and Form2) to edit/add data.
In Sheet1, the first two columns are MovieId and MovieName. We dont know how many rows they will be in this columns.
Form1 controls data in Sheet1, and Form2... in Sheet2.
At Form2 initialization, I want to create a 2 Dimensional Array that will be like (MovieId1,MovieName1;MovieId2,MovieName2;...,...;MovieIdN,MovieNameN), where this data has been extracted from Sheet1, like a sort of Map in Java if you will...
It would actually be ok for me if it was like: (0,"MovieId0;MovieName0";1,"MovieId1,MovieName1";..,"..";N,"MovieIdN,MovieNameN")
I dont know how to create the array with an variable last row number, since the compiler seems to always want a constant to initialize an Array...
Please enlighten me!
Look at the Value method or Value2 property.
e.g. Range("$A$2:$B$4").Value2(1,1)
or
Range("$A$2:$B$4").Value()(1,1)
Array's lower bound start from 1.
lbound(Range("$A$2:$B$4").Value2, 1) - row element starts from
ubound(Range("$A$2:$B$4").Value2, 2) - row element ends
lbound(Range("$A$2:$B$4").Value2, 2) - column element starts from
ubound(Range("$A$2:$B$4").Value2, 2) - column element ends
EDIT: Code to traverse through the array
Dim myAddress As String
Dim dataArray As Variant
Dim rowStart As Long, rowEnd As Long
Dim colStart As Long, colEnd As Long
Dim rowCtr As Long
Dim colCtr As Long
myAddress = "$A$2:$B$4"
dataArray = Range(myAddress).Value2
rowStart = LBound(dataArray, 1)
rowEnd = UBound(dataArray, 1)
colStart = LBound(dataArray, 2)
colEnd = UBound(dataArray, 2)
For rowCtr = rowStart To rowEnd
For colCtr = colStart To colEnd
Debug.Print rowCtr & ":" & colCtr, vbTab & dataArray(rowCtr, colCtr)
Next
Next
EDIT2: In my example, I have assumed the address to be $A$2:$B$4.
You can prefix it with sheet name. e.g. Sheet1!$A$2:$B$4 or Sheet2!$A$2:$B$4
On a side note, array can be defined dynamic (if it is 1 dimensional).
e.g dim my1DArray() as Integer
For double dimension array, see the following code
Dim myArray
Dim dynamicRows As Integer
dynamicRows = 2
ReDim myArray(0 To dynamicRows, 0 To dynamicRows)
myArray(0, 0) = "hello"
dynamicRows = 20
ReDim myArray(0 To dynamicRows, 0 To dynamicRows)
MsgBox myArray(0, 0)
myArray(0, 0) = "hello"
ReDim Preserve myArray(0 To dynamicRows, 0 To dynamicRows)
MsgBox myArray(0, 0)
Rather use the Range object, with this you can also use the UsedRange from the sheet
Sub Macro1()
Dim sheet As Worksheet
Dim range As range
Dim row As Integer
Set sheet = Worksheets("Sheet1")
Set range = sheet.UsedRange
For row = 1 To range.Rows.Count
Next row
End Sub
assuming the data starts in A1
Dim vArr as variant
vArr=worksheets("Sheet1").range("A1").resize(worksheets("Sheet1").range("A65535").end(xlup).row,2)
Do you mean:
Dim thearray() As Variant
ReDim thearray(1, range.Rows.Count)
You can also use a recordset and GetRows to return an array from a worksheet.
Slight mod to Charles' answer:
Dim vArr as variant
vArr = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
Assuming of course that there isn't any stray data in Sheet1.