0

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

Toshi
  • 45
  • 7
  • https://stackoverflow.com/questions/25838330/excel-vba-generate-combinations-of-cells-from-3-columns-or-more – Scott Craner Jan 06 '23 at 17:02
  • You need to iterate each column separately so you will have three nested loops. – Scott Craner Jan 06 '23 at 17:03
  • 1
    Here I have a small function that takes any size array and returns every combination: https://stackoverflow.com/questions/35295430/excel-multiple-columns-different-combinations – Scott Craner Jan 06 '23 at 17:17
  • Theoretically one can use the function in my link answer as a formula in Office 365 and it will spill the results: `=fifth(IF({1},A1:C2))` – Scott Craner Jan 06 '23 at 17:40
  • 1
    Just saw your edit, my function in the second link does what you just edited to include. You would put that in the model then all you have to do is `Result=fifth(dataList)` Or you can take the logic from that function and insert it into your code directly. – Scott Craner Jan 06 '23 at 18:01
  • I realized your message now! Thanks and your answer in the 2nd link worked perfectly! I spent a long time getting nothing, so really amazed I am. Thank you! – Toshi Jan 06 '23 at 18:28

0 Answers0