Is there a way to perform a cross-join for multiple rows X multiple columns using VBA? (No limit to the number of columns & rows. The range should be selectable)
I cannot find the same solution to build up the cross-join of multiple columns by VBA (3 columns limited version exists, but it is not the same), so let me ask it here.
1st, VBA should intake range composed of multiple rows and columns. Suppose there is a 2x4 cell range in Excel like this:
1 a x 5
2 b y 6
Then the VBA should join each row element in each column. The number of columns in the initially selected range should not be changed in the result cross join table. In the case of the above range, the joined result (Cartesian product) should be as below.
1 a x 5
1 a y 5
2 a x 5
2 a y 5
1 b x 5
1 b y 5
2 b x 5
2 b y 5
1 a x 6
1 a y 6
2 a x 6
2 a y 6
1 b x 6
1 b y 6
2 b x 6
2 b y 6
This example only shows the pattern of 4 columns, but I hope it adapts more columns. I made a halfway code below, and I cannot resolve it myself at the part surrounded by ###.
Sub CrossJoin()
Dim i, j, k, m As Long, ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet ' Set the active worksheet
' Prompt the user to select the range of cells containing the data list
Dim temp As Range
Set temp = Application.InputBox(Prompt:="Select the range of cells containing the data list:", Type:=8)
' Store the selected range in the dataList array
Dim dataList As Variant
dataList = temp.Value
' Calculate the number of rows/cols in the dataList array
Dim numRows, numCols As Long
numRows = UBound(dataList, 1)
numCols = UBound(dataList, 2)
' Calculate the number of elements in the result array
Dim numElements As Long
numElements = 1
For i = 1 To numCols
numElements = numElements * numRows
Next i
' Initialize the result array
Dim result As Variant
ReDim result(1 To numElements, 1 To numCols)
' Perform the cross join
Dim elementCounter As Long
elementCounter = 1
For i = 1 To numRows
'### ↓Here I cannot solve what I should write↓ ###
For j = 1 To numCols
result(elementCounter, j) = dataList(i, j)
elementCounter = elementCounter + 1
Next j
'### ↑Here I cannot solve what I should write↑ ###
Next i
Dim dest As Range
Set dest = Application.InputBox(Prompt:="Select the cell where you want to put the result:", Type:=8)
' Paste the result to the worksheet
dest.Resize(UBound(result), UBound(result)).Value = result
End Sub