Thursday, January 3, 2008

Combinations of all values in 3 columns

Here a macro which combines all values from 3 columns and makes unique combinations of it. I created this macro a while ago for someone on Experts-Exchange.com

Sub CombinedValues3Column4()
'Author: J. Rosink
'Date: 11-10-2007 'http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_22949908.html
Dim i, j, k, l, RowsA, RowsB, RowsC, Rw As Long
Dim MyCol1, MyCol2, MyCol3 As Collection
Dim strtime, endtime As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
RowsA = Cells(Rows.Count, 1).End(xlUp).Row
RowsB = Cells(Rows.Count, 2).End(xlUp).Row
RowsC = Cells(Rows.Count, 3).End(xlUp).Row

Set MyCol1 = New Collection
Set MyCol2 = New Collection
Set MyCol3 = New Collection

For i = 1 To RowsA
MyCol1.Add Cells(i, 1)

Next For i = 1 To RowsB
MyCol2.Add Cells(i, 2)
Next

For i = 1 To RowsC
MyCol3.Add Cells(i, 3)
Next
Rw = 1
col = 4
With ActiveSheet

For Each j In MyCol1
For Each k In MyCol2
For Each l In MyCol3

If Rw = 65536 And col < 257 Then
Rw = 1
col = col + 1
If col = 257 Then
Exit Sub
Else
'Exit Sub
End If
.Cells(Rw, col) = j & k & l
Rw = Rw + 1

Next l
Next k
Next j
End With

Set MyCol1 = Nothing
Set MyCol2 = Nothing
Set MyCol3 = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

To use this code:
1. Open Excel
2. Open VBA editor (ALT+F11)
3. Insert new module
4. Paste code.
5. Run Macro

No comments:

Post a Comment