just out of curiosity.
is it possible to dim values in an array as their own individual array?
Sub test()
Dim ar(5) As Variant
ar(1) = a
ar(2) = b
ar(3) = c
ar(4) = d
ar(5) = e
For i = 1 To UBound(ar)
Dim ar(i) As Variant '<---doesn't work :(
Next i
End Sub
If you're after a matrix style array, then you could just define a multi-dimensional array:
Dim ar(5, x) As Variant
But it seems as though you want a jagged array, ie an array of arrays. In that case you just assign an Array() Variant to each element of your array:
Dim ar(5) As Variant
ar(0) = Array(1, 2, 3)
And the syntax to access the 'sub-elements' would be ar(x)(y):
Debug.Print ar(0)(1)
You should be able to set one (or more) position of a Variant array to be an array:
Sub test()
Dim ar(5) As Variant
Dim ar1(1 To 4) As Variant
ar1(1) = 5
ar1(2) = "x"
Set ar1(3) = ActiveSheet
ar1(4) = 10
ar(1) = "a"
ar(2) = "b"
ar(3) = ar1
ar(4) = "d"
ar(5) = "e"
Debug.Print ar(1)
Debug.Print ar(3)(1)
Debug.Print ar(3)(3).Name
End Sub
Related
I need to get a range of cells into an array, which by itself is simple enough:
Dim matchArray As Variant
matchArray = Sheets(lookupSheet).Range("B2:B12000").Value2
This creates a two-dimensional array with one column as the second dimension and if you expand the range to include a second column it creates a two-dimensional array with two columns for the second dimension:
matchArray = Sheets(lookupSheet).Range("B2:C12000").Value2
But what if the two columns aren't next to each other and you don't want the one in the middle?
matchArray = Sheets(lookupSheet).Range("B2:B12000,D2:D12000").Value2
The above would be my best guess but it doesn't work, it only returns the first range specified.
So what I need is a way to return a range cell values into a specific dimension of the array.
I know I could do it by looping through the rows but that would take far too long with the number of rows I'm going to be working with.
You do need a loop -- but loop over VBA arrays rather than individual cells:
Sub Test()
Dim A As Variant, B As Variant, C As Variant
Dim i As Long
B = Sheets(lookupSheet).Range("B2:B12000").Value2
C = Sheets(lookupSheet).Range("D2:D12000").Value2
ReDim A(1 To 11999, 1 To 2)
For i = 1 To 11999
A(i, 1) = B(i, 1)
A(i, 2) = C(i, 2)
Next i
'do stuff with A
End Sub
This should only take a fraction of a second.
You can do it with a ragged array:
Dim var1(1 To 2) As Variant
Dim var As Variant
var = Range("A1:A10").Value2
var1(1) = var
var = Range("c1:c10").Value2
var1(2) = var
MsgBox var1(1)(3, 1)
Here are a couple more ways:
Sub Example1()
Const lookupSheet As String = "Sheet1"
Dim matchArray As Variant, arr1 As Variant, arr2 As Variant
With Sheets(lookupSheet)
arr1 = WorksheetFunction.Transpose(.Range("B2:B12000").Value2)
arr2 = WorksheetFunction.Transpose(.Range("D2:D12000").Value2)
matchArray = WorksheetFunction.Transpose(Array(arr1, arr2))
End With
End Sub
Sub Example2()
Const lookupSheet As String = "Sheet1"
Dim matchArray As Variant
Dim x As Long
With Sheets(lookupSheet)
matchArray = .Range("B2:B12000").Resize(, 2).Value2
For Each v In .Range("D2:D12000").Value2
x = x + 1
matchArray(x, 2) = v
Next
End With
End Sub
Probably no quicker than John Coleman's answer, but I think this does what you want.
Sub x()
Dim matchArray, r As Range
Set r = Sheets(lookupSheet).Range("B2:D12000")
matchArray = Application.Index(r, Evaluate("Row(1:" & r.Rows.Count & ")"), Array(1, 3))
End Sub
I have identified unique values in a list of data by the method I have abbreviated below:
Dim dictionary as scripting.dictionary
Dim data() as String
Dim dataSize as Integer
Dim j as integer
Dim v as variant
DataSize = myRange.Rows.Count
Redim data(dataSize)
For j = 1 to UBound(data)
data(j) = myRange.Cells(j,1).Value
dictionary(data(j)) = 1
Next j
This should be storing the unique values from myRange as the Key values. However, I can't seem to figure out how to access the values. I have tried the following:
For each v in dictionary.Keys()
myVar = v
'dostuff to myVar
next v
and
For each v in dictionary.Keys()
myVar = dictionary.Keys(v)
'dostuff to myVar
next v
but neither works. What am I missing?
Add Set dictionary = New dictionary and then you can loop through:
Sub t()
Dim dictionary As Scripting.dictionary
Dim data() As String
Dim dataSize As Integer
Dim j As Integer
Dim v As Variant
dataSize = myRange.Rows.Count
Set dictionary = New dictionary
ReDim data(dataSize)
For j = 1 To UBound(data)
data(j) = myRange.Cells(j, 1).Value
dictionary(data(j)) = 1
Next j
Dim i As Long
For i = 0 To dictionary.Count - 1
Debug.Print dictionary.Keys()(i) & " " & dictionary.Items()(i)
Next i
End Sub
I have a userform that contains a combobox that's populated from the unique items in a worksheet column. I'm trying to sort the keys that represent the items in the combobox in ascending order using the below code, but I'm getting an "Object variable or With block variable not set" error:
Public Function funcSortKeysByLengthDesc(dctList As Object) As Object
Dim curKey As Variant
Dim key As Variant
Dim itX As Integer
Dim itY As Integer
Dim arrTemp() As Variant
Dim d As Object
'Only sort if more than one item in the dict
If dctList.Count > 1 Then
'Populate the array
ReDim arrTemp(dctList.Count)
itX = 0
For Each curKey In dctList
arrTemp(itX) = curKey
itX = itX + 1
Next
For itX = 0 To (dctList.Count - 2)
For itY = (itX + 1) To (dctList.Count - 1)
If arrTemp(itX) > arrTemp(itY) Then
curKey = arrTemp(itY)
arrTemp(itY) = arrTemp(itX)
arrTemp(itX) = curKey
End If
Next
Next
'Create the new dictionary
Set d = CreateObject("Scripting.Dictionary")
For itX = 0 To UBound(arrTemp)
d.Add arrTemp(itX), dctList(itX)
Next
Set funcSortKeysByLengthDesc = d
Else
Set funcSortKeysByLengthDesc = dctList
End If
End Function
I'm not really sure why you're using a Dicionary for this task, but I've assumed it's required elsewhere in your project, so I've tried to dovetail mine into your existing code.
If you are only putting sorted cells into a ComboBox then reading the cells into an array, removing duplicates and sorting that array, then populating the ComboBox would be simpler. There are plenty of examples of how to do each of these tasks on this site, so I won't reproduce them here.
Here's the code for you:
Sub RunMe()
Dim ws As Worksheet
Dim rCell As Range
Dim dctItem As String
Dim dctArray() As String
Dim i As Integer
Dim d As Object
Dim v As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Code to poulate a few "C" cells
ws.Cells(3, "C").Resize(10).Value = Application.Transpose(Array("Z", "Y", "X", "W", "W", "E", "D", "C", "B", "A"))
UserForm1.Show False
'Clear the combobox
UserForm1.cbNames.Clear
'Create the dictionary
Set d = CreateObject("Scripting.Dictionary")
For Each rCell In ws.Range("C3", ws.Cells(Rows.Count, "C").End(xlUp))
dctItem = CStr(rCell.Value2)
If Not d.Exists(dctItem) Then
d.Add dctItem, dctItem
End If
Next
'Convert the dictionary items to an array
Debug.Print "PRE-SORT"
ReDim dctArray(1 To d.Count)
i = 1
For Each v In d.Items
dctArray(i) = v
i = i + 1
Debug.Print v
Next
'Bubble sort the array
dctArray = BubbleSort(dctArray)
'Populate the dictionary and combobox
Debug.Print "POST-SORT"
Set d = CreateObject("Scripting.Dictionary")
For i = LBound(dctArray) To UBound(dctArray)
d.Add dctArray(i), dctArray(i)
UserForm1.cbNames.AddItem dctArray(i)
Debug.Print dctArray(i)
Next
End Sub
Private Function BubbleSort(tempArray As Variant) As Variant
'Uses Microsoft's version: https://support.microsoft.com/en-us/kb/133135
Dim temp As Variant
Dim i As Integer
Dim noExchanges As Integer
' Loop until no more "exchanges" are made.
Do
noExchanges = True
' Loop through each element in the array.
For i = 1 To UBound(tempArray) - 1
' If the element is greater than the element
' following it, exchange the two elements.
If tempArray(i) > tempArray(i + 1) Then
noExchanges = False
temp = tempArray(i)
tempArray(i) = tempArray(i + 1)
tempArray(i + 1) = temp
End If
Next i
Loop While Not (noExchanges)
BubbleSort = tempArray
End Function
Why we can't assign values from range into static array :
Sub test()
'error occours
Dim a(1 to 10) as Double
'also don't work :
'Dim a(1 To 10, t To 1) as Double
a = Range("A1:A10")
End Sub
Because the array has already been allocated, regardless of how many dimensions you use.
Dim x(1 to 10, 1 to 1) As Variant '// You've allocated the array
x = Range("A1:A10").Value '// Can't allocate to an already allocated array
You can declare an array of type Variant without allocating it and use that instead:
Dim x() As Variant '// Array is NOT allocated
x = Range("A1:A10") '// x = Array sized 1 to 10, 1 to 1
Assigning a range directly to an array in this way will always return a type Variant/Variant and so the receiving array must be of type Variant also.
You could create a UDF to do this for you, but it kind of defies the point of assigning directly from range:
Sub SO()
Dim a As Variant
a = RangeToArray(Range("A1:A10"))
End Sub
Function RangeToArray(rng As Range) As Variant
ReDim x(1 To rng.Rows.count, 1 To rng.Columns.count) As Variant
Dim r As Long, c As Long
For r = 1 To rng.Rows.count
For c = 1 To rng.Columns.count
x(r, c) = rng.Cells(r, c)
Next c
Next r
RangeToArray = x
End Function
In the cell A1 of my Excel sheet named 'Sheet2' has the following formula (CSE Array Formula)
{=INDEX(Data1, MATCH(F26&G26,Data2&Data3,0),7)}
Data1 = Sheet1!$D$3:$J$604
Data2 = Sheet1!$D$3:$D$604
Data3 = Sheet1!$D$3:$E604
I want to rewrite this in VBA Macro, and the below is what I have tried so far (Yes, it is giving me an error (ERROR: Can't assign to array)
Sub Button1_Click()
Dim var1(1 To 10) As Integer
Dim var2(1 To 10) As Integer
With Application.WorksheetFunction
var1 = .Match((F26 And G26), (Worksheets("Sheet1").Range("D3:D604") And Worksheets("Sheet1").Range("E3:E604")), 0)
var2 = .Index(Worksheets("Sheet1").Range("D3:J604"), var1, 7)
Range("A1").Value = var2
End With
End Sub
Any suggestion/correction please?
why are you defining var1 and var2 as arrays?
To concatenate strings, use the same & operator as the formula: (F26 & G26)
To concatenate ranges, use the Application.Union() method: Application.Union(range1, range2)
I assume from the function, you want to return an array of all the places in your area that match the values in F26 and G26
This would be my attempt:
Option Explicit
Sub Button1_Click()
Dim Values()
Dim FindData
Dim Counter As Long
Dim DataPoints As Long
Dim ReturnData()
ReDim ReturnData(1)
DataPoints = 1
Values = Application.Union(Range("D3::D604"),Range("E3:E604"))
FindData = Range("F26").Value & Range("G26").Value
For Counter = LBound(Values) To UBound(Values)
If findata = (Values(Counter, 1) & Values(Counter, 2)) Then
ReDim Preserve ReturnData(DataPoints)
ReturnData(DataPoints) = Counter
DataPoints = DataPoints + 1
End If
Next
Range("A1:A" & DataPoints) = ReturnData
End Sub