Skip to content

Instantly share code, notes, and snippets.

@martinctc
Last active March 1, 2019 21:25
Show Gist options
  • Save martinctc/d84ad653e2186a25f4580e2a6745f9b2 to your computer and use it in GitHub Desktop.
Save martinctc/d84ad653e2186a25f4580e2a6745f9b2 to your computer and use it in GitHub Desktop.
[Collate two variables to output all possible combinations] #Excel
Sub Collater()
'You will have a two-column data table (with headers) and as many rows as you want.
'It doesn't matter whether your data consists of text or number - no "calculation" is run directly on the values.
'You want to "multiply out" your data to get all possible combinations.
'Ordering: Column A for the variable to repeat multiple times (e.g. Alice, Alice, Alice, Bob, Bob, Bob)
'Ordering: Column B for the variable to display in sequence (e.g. 15, 20, 30, 15, 20, 30)
'Leave first row blank
Dim wb As Workbook
Dim ws As Worksheet
Dim k, p, i As Integer
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Application.ScreenUpdating = False
'The value 'k' is the total count of values in column A.
'The value 'p' is the total count of values in column B.
'The value 'i' shows the total number of combinations of your two variables - simple multiplification.
k = ws.Application.CountA(Range("A:A"))
p = ws.Application.CountA(Range("B:B"))
i = k * p
'Prints these values on the header row of your first three columns.
Range("A1").Value = k
Range("B1").Value = p
Range("C1").Value = i
'The commented column immediately below is an alternative method using formulas instead of VBA code - just ignore.
'Range("A1").Formula = "=COUNTA(A2:A9999)"
'Range("B1").Formula = "=COUNTA(B2:B9999)"
'Range("A1").Copy
'Range("A1").PasteSpecial (xlPasteValues)
'Range("B1").Copy
'Range("B1").PasteSpecial (xlPasteValues)
'Range("C1").Formula = "=A1*B1"
'i = Range("C1")
'The output would appear in Columns D and E.
'Please ensure you save your work first!
'Column references may be changed to suit your needs.
Range("D:D").ClearContents
Range("E:E").ClearContents
Range("D1").Value = "Col1"
Range("E1").Value = "Col2"
Range("D2").Formula = "=INDIRECT(""A""&IF(MOD(ROW(A1),$B$1)=0,QUOTIENT(ROW(A1),$B$1)+1,QUOTIENT(ROW(A1),$B$1)+2))"
Range("D2").Select
Range("D2").Copy
Range("D2").Resize(i, 1).PasteSpecial (xlPasteAll)
Range("E2").Formula = "=IF(MOD(ROW(B1),$B$1)=0,INDIRECT(""B""&$B$1+1),INDIRECT(""B""&MOD(ROW(B1),$B$1)+1))"
Range("E2").Select
Range("E2").Copy
Range("E2").Resize(i, 1).PasteSpecial (xlPasteAll)
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "All done mate."
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment