A good solution to this question for one row in excel sheet was offered in another post by user Tony Dallimore.
In the case of a worksheet that contains the following data in one row:
A B C
abc,def,ghi,jkl 1,2,3 a1,e3,h5,j8
After applying the following VBA macro:
Sub Combinations()
Dim ColCrnt As Long
Dim ColMax As Long
Dim IndexCrnt() As Long
Dim IndexMax() As Long
Dim RowCrnt As Long
Dim SubStrings() As String
Dim TimeStart As Single
TimeStart = Timer
With Worksheets("Combinations")
' Use row 1 as the source row. Find last used column.
ColMax = .Cells(1, Columns.Count).End(xlToLeft).Column
' Size Index arrays according to number of columns
' Use one based arrays so entry number matches column number
ReDim IndexCrnt(1 To ColMax)
ReDim IndexMax(1 To ColMax)
' Initialise arrays
For ColCrnt = 1 To ColMax
SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
' SubStrings is a zero-based array with one entry
' per comma separated value.
IndexMax(ColCrnt) = UBound(SubStrings)
IndexCrnt(ColCrnt) = 0
Next
RowCrnt = 3 ' Output generated values starting at row 3
Do While True
' Use IndexCrnt() here.
' For this version I output the index values
For ColCrnt = 1 To ColMax
SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
.Cells(RowCrnt, ColCrnt).Value = SubStrings(IndexCrnt(ColCrnt))
Next
RowCrnt = RowCrnt + 1
' Increment values in IndexCrnt() from right to left
For ColCrnt = ColMax To 1 Step -1
If IndexCrnt(ColCrnt) < IndexMax(ColCrnt) Then
' This column's current index can be incremented
IndexCrnt(ColCrnt) = IndexCrnt(ColCrnt) + 1
Exit For
End If
If ColCrnt = 1 Then
' Leftmost column has overflowed.
' All combinations of index value have been generated.
Exit Do
End If
IndexCrnt(ColCrnt) = 0
' Loop to increment next column
Next
Loop
End With
Debug.Print Format(Timer - TimeStart, "#,###.##")
End Sub
The result is all combinations of data in different columns, while these combinations are displayed in the same worksheet, starting with the third row: (part of the output is displayed below)
abc 1 a1
abc 2 a1
abc 3 a1
abc 1 e3
abc 2 e3
abc 3 h5
However, I would be interested in how this VBA macro can be modified so that it is applied sequentially to more than one row (for any number of rows), while the output would be displayed either two rows below the last row of the input table or on the next worksheet. Unfortunately, my attempts at modification were unsuccessful. thanks in advance for every answer and at the same time this is my first post on stackoverflow, so sorry for any mistakes in the structure of the question.
Example of input table:
A B C
abc,def 1,2 a1,e3
abc,def 1,2 a1,e3
Example of output table:
A B C
abc 1 a1
abc 1 e3
abc 2 a1
abc 2 e3
def 1 a1
def 1 e3
def 2 a1
def 2 e3
abc 1 a1
abc 1 e3
abc 2 a1
abc 2 e3
def 1 a1
def 1 e3
def 2 a1
def 2 e3
Here's another approach that should work, it's a bunch of nested for loops to enumerate all the possible combinations. I'd just do a remove duplicates at the end, this should be pretty fast. Alternatively, using a dictionary would work too.
Sub CreateCombos()
Dim ColumnA As Variant
Dim ColumnB As Variant
Dim ColumnC As Variant
Dim i As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim j As Long
Dim results As Variant
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
'Create an array large enough to hold all the values
ReDim results(1 To 3, 1 To 50000)
'Iterate each of the combinations listed as comma separated values
'Should be easy to make this dynamic if you need to iterate specific cells
For i = 1 To 2
ColumnA = Split(ws.Cells(i, 1), ",")
ColumnB = Split(ws.Cells(i, 2), ",")
ColumnC = Split(ws.Cells(i, 3), ",")
For a = LBound(ColumnA) To UBound(ColumnA)
For b = LBound(ColumnB) To UBound(ColumnB)
For c = LBound(ColumnC) To UBound(ColumnC)
j = j + 1
results(1, j) = ColumnA(a)
results(2, j) = ColumnB(b)
results(3, j) = ColumnC(c)
Next
Next
Next
Next
ReDim Preserve results(1 To 3, 1 To j)
ws.Range("A4:C" & (j + 3)) = Application.Transpose(results)
End Sub