Indexing error out of range with Cartesian product
I am trying to find a 4 column cartesian product that has data separated by a delimiter
Example
ID ID2 String String2
1234 33423,43222,442224,213432 Sample;repeat;example;multiple second; possible;delimiter
2345 12354; 55633; 343534;65443;121121 data;set;sample;find answer;combination;by
and I am getting an "Out of Range" error with the below code. Can anyone help on where this is going wrong?
Sub Cartesian()
Dim MyStr1 As Variant, MyStr2 As Variant, MyStr3 As Variant, MyStr4 As Variant, _
Str1 As Variant, Str2 As Variant, Str3 As Variant, Str4 As Variant, X As Long, _
OrigString1 As Variant, OrigString2 As Variant, OrigString3 As Variant, _
OrigString4 As Variant, Y As Long
OrigString1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
OrigString2 = Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
OrigString3 = Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
OrigString4 = Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
X = 2
For Y = LBound(OrigString1) To UBound(OrigString1)
MyStr1 = Split(OrigString1(Y), ";")
MyStr2 = Split(OrigString2(Y), ";")
MyStr3 = Split(OrigString3(Y), ";")
MyStr4 = Split(OrigString4(Y), ";")
For Each Str1 In MyStr1
For Each Str2 In MyStr2
For Each Str3 In MyStr3
For Each Str4 In MyStr4
Range("A" & X).Formula = Str1
Range("B" & X).Formula = Str2
Range("C" & X).Formula = Str3
Range("D" & X).Formula = Str4
X = X + 1
Next
Next
Next
Next
Next
End Sub
Or is there a better way to handle this using sql? Or is there any better way to achieve the cartesian product of each line using VBA?
source to share
Something like this works. I couldn't find a more elegant solution.
Sub Cartesian()
Dim MyStr1() As String
Dim MyStr2() As String
Dim MyStr3() As String
Dim MyStr4() As String
Dim X As Long
Dim OrigString1() As String
Dim OrigString2() As String
Dim OrigString3() As String
Dim OrigString4() As String
Dim Y As Long
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
ReDim OrigString1(1 To Range("A" & Rows.Count).End(xlUp).Row - 1)
For Y = 1 To UBound(OrigString1)
OrigString1(Y) = CStr(Range("A" & CStr(Y + 1)).Value)
Next
ReDim OrigString2(1 To Range("B" & Rows.Count).End(xlUp).Row - 1)
For Y = 1 To UBound(OrigString2)
OrigString2(Y) = CStr(Range("B" & CStr(Y + 1)).Value)
Next
ReDim OrigString3(1 To Range("C" & Rows.Count).End(xlUp).Row - 1)
For Y = 1 To UBound(OrigString3)
OrigString3(Y) = CStr(Range("C" & CStr(Y + 1)).Value)
Next
ReDim OrigString4(1 To Range("D" & Rows.Count).End(xlUp).Row - 1)
For Y = 1 To UBound(OrigString4)
OrigString4(Y) = CStr(Range("D" & CStr(Y + 1)).Value)
Next
X = 2
For Y = LBound(OrigString1) To UBound(OrigString1)
MyStr1() = Split(OrigString1(Y), ";")
MyStr2() = Split(OrigString2(Y), ";")
MyStr3() = Split(OrigString3(Y), ";")
MyStr4() = Split(OrigString4(Y), ";")
For Each Str1 In MyStr1
For Each Str2 In MyStr2
For Each Str3 In MyStr3
For Each Str4 In MyStr4
Range("A" & X).Formula = Str1
Range("B" & X).Formula = Str2
Range("C" & X).Formula = Str3
Range("D" & X).Formula = Str4
X = X + 1
Next
Next
Next
Next
Next
End Sub
source to share
When you populate a block of cell values in a variant array, it is best not to rely on the default property .Value
. Specify explicitly that you want to get the value from the cells. In fact, use .Value2
to get baseline values from cells.
OrigString1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value2
OrigString2 = Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value2
OrigString3 = Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value2
OrigString4 = Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row).Value2
For details .Value2
see Property Range.Value2 . The specific minor properties of the Currency and Date value types are not important when trying to bulk process in memory; only when the original values are returned to the worksheet.
source to share