Maybe something like this
I think that there's 6^12 = 2,176,782,336 combanations, so thats a lot of computer time and a lot of disc space
It might be better to rethink where you want to go with this
'always a good idea and usually recommended
Option Explicit
Sub ListAllCombinations()
'without the 'As Range' on every one, the system assumed that they're Variant
Dim xDRg1 As Range, xDRg2 As Range, xDRg3 As Range, xDRg4 As Range, xDRg5 As Range, xDRg6 As Range
Dim xDRg7 As Range, xDRg8 As Range, xDRg9 As Range, xDRg10 As Range, xDRg11 As Range, xDRg12 As Range
Dim xStr As String
Dim xFN1 As Long, xFN2 As Long, xFN3 As Long, xFN4 As Long, xFN5 As Long, xFN6 As Long
Dim xFN7 As Long, xFN8 As Long, xFN9 As Long, xFN10 As Long, xFN11 As Long, xFN12 As Long
Dim xSV1 As String, xSV2 As String, xSV3 As String, xSV4 As String, xSV5 As String, xSV6 As String
Dim xSV7 As String, xSV8 As String, xSV9 As String, xSV10 As String, xSV11 As String, xSV12 As String
'file stuff
Dim iFilenum As Long
Dim sFileName As String, sLine As String
Dim iCounter As Long
Dim dTotal As Double
Set xDRg1 = Range("A2:A7") '1 column data
Set xDRg2 = Range("B2:B7") '2 column data
Set xDRg3 = Range("C2:C7") '3 column data
Set xDRg4 = Range("D2:D7") '4 column data
Set xDRg5 = Range("E2:E7") '5 column data
Set xDRg6 = Range("F2:F7") '6 column data
Set xDRg7 = Range("G2:G7") '7 column data
Set xDRg8 = Range("H2:H7") '8 column data
Set xDRg9 = Range("I2:I7") '9 column data
Set xDRg10 = Range("J2:J7") '10 column data
Set xDRg11 = Range("K2:K7") '11 column data
Set xDRg12 = Range("L2:L7") '12 column data
xStr = "," 'Separator
'file
iCounter = 1
dTotal = 6# ^ 12#
iFilenum = FreeFile
sFileName = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & ".csv"
On Error Resume Next
Application.DisplayAlerts = False
Kill sFileName
Application.DisplayAlerts = True
On Error GoTo 0
Open sFileName For Output As #iFilenum
For xFN1 = 1 To xDRg1.Count
xSV1 = xDRg1.Item(xFN1).Text
For xFN2 = 1 To xDRg2.Count
xSV2 = xDRg2.Item(xFN2).Text
For xFN3 = 1 To xDRg3.Count
xSV3 = xDRg3.Item(xFN3).Text
For xFN4 = 1 To xDRg4.Count
xSV4 = xDRg4.Item(xFN4).Text
For xFN5 = 1 To xDRg5.Count
xSV5 = xDRg5.Item(xFN5).Text
For xFN6 = 1 To xDRg6.Count
xSV6 = xDRg6.Item(xFN6).Text
For xFN7 = 1 To xDRg7.Count
xSV7 = xDRg7.Item(xFN7).Text
For xFN8 = 1 To xDRg8.Count
xSV8 = xDRg8.Item(xFN8).Text
For xFN9 = 1 To xDRg9.Count
xSV9 = xDRg9.Item(xFN9).Text
For xFN10 = 1 To xDRg10.Count
xSV10 = xDRg10.Item(xFN10).Text
For xFN11 = 1 To xDRg11.Count
xSV11 = xDRg11.Item(xFN11).Text
For xFN12 = 1 To xDRg12.Count
xSV12 = xDRg12.Item(xFN12).Text
sLine = xSV1 & xStr & xSV2 & xStr & xSV3 & xStr & xSV4 & xStr & xSV5 & xStr & xSV6 & xStr & xSV7 & xStr & xSV8 & xStr & xSV9 & xStr & xSV10 & xStr & xSV11 & xStr & xSV12
If iCounter Mod 1000 = 1 Then
Application.StatusBar = "Case #" & Format(iCounter, "#,##0") & " (" & Format(CDbl(iCounter) / dTotal, "#0.00%") & ")"
DoEvents
End If
Print #iFilenum, sLine
iCounter = iCounter + 1
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Close iFilenum
Application.StatusBar = False
MsgBox "Done"
End Sub
Reply With Quote
Originally Posted by RIC63
