1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
| Sub Combos()
Dim Element(), Index()
Dim MyCols As Variant, MySheet As Worksheet, OneCol As Boolean
Dim r As Long, c As Long, ctr As Long, mysize As Long
Dim delim As String, OutputCol As String, str1 As String
' Set up conditions
Set MySheet = Sheets("Sheet1")
MyCols = Array("A", "B", "C")
OutputCol = "F"
OneCol = True
delim = ""
' resize the arrays
ReDim Element(255, UBound(MyCols))
ReDim Index(UBound(MyCols))
' Read the elements
For c = 0 To UBound(MyCols)
Element(0, c) = 0
Index(c) = 1
For r = 1 To 255
If MySheet.Cells(r, MyCols(c)) <> "" Then
Element(0, c) = Element(0, c) + 1
Element(Element(0, c), c) = MySheet.Cells(r, MyCols(c))
End If
Next r
Next c
' Clear the output columns(s), and check for the number of results
ctr = MySheet.Cells(1, OutputCol).Column
mysize = 1
For c = 0 To UBound(MyCols)
mysize = mysize * Element(0, c)
MySheet.Columns(ctr).ClearContents
ctr = ctr + 1
Next c
If mysize > 1000000 Then
MsgBox "The number of results is too big to handle!"
Exit Sub
End If
ctr = 0
' Start creating combinations
Loop1:
ctr = ctr + 1
str1 = ""
Set resultcell = MySheet.Cells(ctr, OutputCol)
For c = 0 To UBound(MyCols)
If OneCol Then
str1 = str1 & Element(Index(c), c) & delim
Else
resultcell.Value = Element(Index(c), c)
Set resultcell = resultcell.Offset(0, 1)
End If
Next c
If OneCol Then MySheet.Cells(ctr, OutputCol) = Left(str1, Len(str1) - Len(delim))
' Increment the indices
For c = 0 To UBound(MyCols)
Index(c) = Index(c) + 1
If Index(c) <= Element(0, c) Then Exit For
Index(c) = 1
Next c
If c <= UBound(MyCols) Then GoTo Loop1:
End Sub |
