Suppose that in another cell I have A. So what I want is to for A I will bring into array1 = Array("0","80") and array2 = Array("100","240"). But it has to return array1,array2 in the same order of values, that is, 0, 80, 100, 240.
A 0 100
B 25 75
A 80 240
B 30 90
I was thinking about working with ranges, for instance, it will look into the table for example the 2 first columns and then if A = A then it will add all the values from 2nd column matching A in array1 and then all the values from 3rd column matching A in array2. Or is it better to work with cells positions?
Hope to hear news from you. Thanks
you'd better work with arrays directly:
Option Explicit
Sub main()
Dim dataArr As Variant
Dim nFounds As Long, iArr As Long
Dim myVal As Variant
myVal = Range("E1").Value '<--| set "E1" to your actual "another cell" address
With Worksheets("data") '<--| change "data" to your actual worksheet name
dataArr = .Range("C1", .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
ReDim array1(1 To UBound(dataArr)) As Variant, array2(1 To UBound(dataArr)) As Variant
For iArr = 1 To UBound(dataArr)
If dataArr(iArr, 1) = myVal Then
array1(nFounds + 1) = dataArr(iArr, 2)
array2(nFounds + 1) = dataArr(iArr, 3)
nFounds = nFounds + 1
End If
Next
If nFounds > 0 Then ReDim Preserve array1(1 To nFounds) As Variant, array2(1 To nFounds) As Variant
End Sub
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 have a very basic question, but would love to know how to do this. I want to write a function in VBA where I can highlight a column as an input, and then spit out the result somewhere else.
Thanks in advance :)
e.g. column A
--------
10
8
5
6
1
3
2
becomes:
column A
--------
10
8
6
2
I just did it from column a to b, but you probably want range as the current selection and a different output column.
Option Explicit
Sub filterlist()
Dim rng As Range
Set rng = Range("a1:a5")
Dim celluse As Range
Dim arr As Variant
For Each celluse In rng
If celluse.Value Mod 2 = 0 Then
If IsEmpty(arr) Then
arr = Array(celluse.Value)
Else
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = celluse.Value
End If
End If
Next celluse
Dim i As Long
For i = 0 To UBound(arr)
Range("b" & i + 1) = arr(i)
Next i
End Sub
This code should do the trick.
You can enter as an array-formula directly to a sheet: {=RemoveOdds(A1:A7)} or as part of another procedure:
Sub Test()
RemoveOdds Selection
End Sub
Public Function RemoveOdds(Target As Range) As Variant
Dim vFinal() As Variant
Dim rCell As Range
Dim x As Long
ReDim vFinal(1 To Target.Cells.Count)
x = 1
For Each rCell In Target
If rCell Mod 2 = 0 Then
vFinal(x) = rCell.Value
x = x + 1
End If
Next rCell
'So missing values do not show up as 0 at bottom of array.
' Do While x <= Target.Cells.Count
' vFinal(x) = ""
' x = x + 1
' Loop
ReDim Preserve vFinal(1 To x - 1)
'RemoveOdds = vFinal 'Basic array - will place values horizontally on sheet.
RemoveOdds = Application.Transpose(vFinal) 'Will place values vertically on sheet.
End Function
I'm trying to get a 2D array of size [x][3] filled. X is just the size of the sheet (number of rows) and there are 3 columns which I am interested in. The columns are not near each other, for instance arr[i][0] should be filled from column AA, arr[i][1] should come from column K, and arr[i][2] needs to be from columns L.
I tried assigning it the following way, but got an error in the array value assignment.
Any help on this would be greatly appreciated!
Code:
Sub SOC_work()
'Trying to sort each of the disciplines further, by Stage of Construction
Dim ar_SOC() As Variant
Dim int_NumRows As Long
Dim i_counter As Long
Dim j_Counter As Long
Dim lite As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("AVEVA_PBOM_PARTS").Select
'Redimension the array size to the amount of parts in the PBOM
int_NumRows = ActiveSheet.UsedRange.Rows.count - 1
ReDim ar_SOC(int_NumRows, 3)
'now assignt he range into the array space
lite = Range("AA2", Range("AA2").End(xlDown))
ar_SOC[][1]=lite
End Sub
Is there any way to do this without looping through the entire column?
As described in the comments, you can fill three 2-D arrays. You can then populate a fourth array from the three arrays, like below.
Sub populateArray()
Dim arrColOne() As Variant, arrColTwo() As Variant, arrColThree() As Variant
Dim arrAllData() As Variant
Dim i As Long
arrColOne = Range("A2:A" & lrow(1)) 'amend column number
arrColTwo = Range("D2:D" & lrow(4))
arrColThree = Range("G2:G" & lrow(7))
ReDim arrAllData(1 To UBound(arrColOne, 1), 2) As Variant
For i = 1 To UBound(arrColOne, 1)
arrAllData(i, 0) = arrColOne(i, 1)
arrAllData(i, 1) = arrColTwo(i, 1)
arrAllData(i, 2) = arrColThree(i, 1)
Next i
End Sub
Public Function lrow(colNum As Integer) As Long
lrow = Cells(Rows.Count, colNum).End(xlUp).Row
End Function
The above will require all 3 columns to be the same length (otherwise populating the last array will not work); this is due to the fourth array being redimensioned to contain the number of elements contained in the first array.
Testing with 250,000 rows of data, the fourth array populated in 0.43 seconds.
How lenient are you with the array you get in return? I can get you a Array(col)(row)-style array, without having to loop to get it, if that works. Note that's not Array(col, row), by the way. It's a single-dimensional array of columns, with each element containing a single-dimensional array of row values. If you're okay with that, you can do this:
Dim a(1 To 3)
a(1) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("AA2:AA10")), 1, 0)
a(2) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("K2:K10" )), 1, 0)
a(3) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("L2:L10" )), 1, 0)
Then you could access your array items like so:
Debug.Print UBound(a) ' Number of columns (3)
Debug.Print UBound(a(1)) ' Number of rows in column 1
Debug.Print a(1)(3) ' Value of column 1 (AA), row 3
The Index() function can return a 1D array but only in the rows direction. So, you need to combine it with Transpose() to return a 1D column array. That's all the code above is doing.
What about an array of arrays?
Sub NoLoop()
Dim R1 As Range, R2 As Range, R3 As Range
Dim Arr1() As Variant, Arr2() As Variant, Arr3() As Variant
Dim LR As Long
LR1 = Cells(Rows.Count, "AA").End(xlUp).Row
LR2 = Cells(Rows.Count, "K").End(xlUp).Row
LR3 = Cells(Rows.Count, "L").End(xlUp).Row
Set R1 = Range(Cells(1, "AA"), Cells(LR1, "AA"))
Set R2 = Range(Cells(1, "K"), Cells(LR2, "K"))
Set R3 = Range(Cells(1, "L"), Cells(LR3, "L"))
Arr1 = R1.Value
Arr2 = R2.Value
Arr3 = R3.Value
ArrArr = Array(Arr1, Arr2, Arr3)
End Sub
With this you can call your values using:
MyVal = ArrArr(0)(1,1)
MyVal = ArrArr(0)(2,1)
MyVal = ArrArr(1)(1,1)
Where the first number is for the array (starts from 0 and ends with 2) and the second number is for row/cell of the range used to fill array.
The third number is always 1 (because adding a range to an array returns a bidimensional array)
With this code you can also have different dimensions for each column so to save memory.
I have the following (on the surface of it, simple) task:
Copy the values from a number of columns on a spreadsheet into a 2D array using VBA.
To make life more interesting, the columns are not adjacent, but they are all of the same length. Obviously one could do this by looping over every element in turn, but that seems very inelegant. I am hoping there is a more compact solution - but I struggle to find it.
Here are some attempts of what I would consider "a simple approach" - for simplicity, I am putting the range as A1:A5, D1:D5 - a total of 10 cells in two ranges.
Private Sub testIt()
Dim r1, r2, ra, rd, rad
Dim valString, valUnion, valBlock
Set r1 = Range("A1:A5")
Set r2 = Range("D1:D5")
valString = Range("A1:A5,D1:D5").Value
valUnion = Union(r1, r2).Value
valBlock = Range("A1:D5").Value
End Sub
When I look at each of these variables, the first two have dimension (1 To 5, 1 To 1) while the last one has (1 To 5, 1 To 4). I was expecting to get (1 To 5, 1 To 2) for the first two, but that was not the case.
I would be happy if I could loop over the data one column at the time, and assign all the values in one column to one column in the array - but I could not figure out how to do that either. Something like
cNames = Array("A", "D")
ci = 1
For Each c in columnNames
vals( , ci) = Range(c & "1:" & c & "5").Value
ci = ci + 1
Next c
But that's not the right syntax. The result I want to get would be achieved with
cNames = Array("A", "D")
ci = 1
For Each c in columnNames
For ri = 1 To 5
vals(ri , ci) = Range(c & "1").offset(ri-1,0).Value
Next ri
ci = ci + 1
Next c
But that's pretty ugly. So here is my question:
Is it possible to get the values of a "composite range" (multiple non-contiguous blocks) into an array - either all at once, or a columns at a time? If so, how do I do it?
For extra bonus points - can anyone explain why the arrays returned in testIt() are dimensioned Base 1, whereas my VBA is set to Option Base 0? In other words - why are they not (0 To 4, 0 To 0)? Is this just one more inconsistency on the part of Microsoft?
Provided each area in rng has the same number of rows then this should work.
Function ToArray(rng) As Variant()
Dim arr() As Variant, r As Long, nr As Long
Dim ar As Range, c As Range, cnum As Long, rnum As Long
Dim col As Range
nr = rng.Areas(1).Rows.Count
ReDim arr(1 To nr, 1 To rng.Cells.Count / nr)
cnum = 0
For Each ar In rng.Areas
For Each col In ar.Columns
cnum = cnum + 1
rnum = 1
For Each c In col.Cells
arr(rnum, cnum) = c.Value
rnum = rnum + 1 'EDIT: added missing line...
Next c
Next col
Next ar
ToArray = arr
End Function
Usage:
Dim arr
arr = ToArray(Activesheet.Range("A1:A5,D1:D5"))
Debug.Print UBound(arr,1), UBound(arr,2)
As for why array from rng.Value are 1-based instead of zero-based, I'd guess it's because that maps more readily to actual row/column numbers on the worksheet than if it were zero-based. The Option Base x setting is ignored
It is possible to accomplish what you want if you're willing to add a hidden worksheet. I used Excel 2010 and created two worksheets (Sheet1 / Sheet2) to test my findings. Below is the code:
Private Sub TestIt()
' Src = source
' Dst = destination
' WS = worksheet
Dim Data As Variant
Dim SrcWS As Excel.Worksheet
Dim DstWS As Excel.Worksheet
' Get a reference to the worksheet containing the
' source data
Set SrcWS = ThisWorkbook.Worksheets("Sheet1")
' Get a reference to a hidden worksheet.
Set DstWS = ThisWorkbook.Worksheets("Sheet2")
' Delete any data found on the hidden worksheet
DstWS.UsedRange.Columns.EntireColumn.Delete
' Copy the non-contiguous range into the hidden
' worksheet.
SrcWS.Range("A1:A5,D1:D5").Copy DstWS.Range("A1")
' Now all of the data can be stored in a variable
' as a 2D array because it will be contiguous on
' the hidden worksheet.
Data = DstWS.UsedRange.Value
End Sub
Tim,
Thanks for your sample code. I had some problems with it and had to rewrite some portions of it. It wasn't counting through the rows and columns correctly. I have test this and it is working 100%
Function ToArray(rng As Range) As Variant()
Dim arr() As Variant, r As Long, nr As Long
Dim ar As Range, c As Range, cnum As Long, rnum As Long
Dim col As Range
Dim lastrow As Integer
Dim saverow() As Integer
Dim lastcolumn As Integer
Dim templastcolumn As Integer
For i = 1 To rng.Areas.Count
templastcolumn = (rng.Areas(i).Column + rng.Areas(i).CountLarge) - 1
If lastrow <> rng.Areas(i).Row Then
nr = nr + rng.Areas(i).Rows.Count
lastrow = rng.Areas(i).Row
End If
If lastcolumn < templastcolumn Then lastcolumn = templastcolumn
Next i
ReDim arr(1 To nr, 1 To lastcolumn)
ReDim saverow(1 To lastrow)
cnum = 0
rnum = 0
lastrow = 0
For Each ar In rng.Areas
If lastrow <> ar.Row Then
lastrow = ar.Row
cnum = 0
End If
For Each col In ar.Columns
cnum = cnum + 1
For Each c In col.Cells
If saverow(c.Row) = 0 Then
rnum = rnum + 1
saverow(c.Row) = rnum
End If
arr(saverow(c.Row), cnum) = c.value
Next c
Next col
Next ar
ToArray = arr
End Function
Sub TestCopyArray()
Dim arr As Variant
arr = ToArray(ThisWorkbook.Sheets("MSS").Range("B1:D2,G1:J2,B4:D4,B6:D6"))
ThisWorkbook.Sheets("Sheet1").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub
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.