Option Explicit
Dim CurrentRow As Long
Dim Combis(1 To 360360, 0) As String
Sub Combins()
Dim wf, x As Long, i As Long, j As Long, k As Long, m As Long, n As Long
Dim OriginalString As String, NewString As String
Application.ScreenUpdating = False
Dim combistr As String
Set wf = Application.WorksheetFunction
x = 0
CurrentRow = 1
For i = 1 To 11
For j = i + 1 To 12
For k = j + 1 To 13
For m = k + 1 To 14
For n = m + 1 To 15
'because there are only 15 numbers, I converted to Hexadecimal so that all resulting strings would be 5 characters long.
combistr = wf.Dec2Hex(i) & wf.Dec2Hex(j) & wf.Dec2Hex(k) & wf.Dec2Hex(m) & wf.Dec2Hex(n)
'Debug.Print combistr
GetPermutation "", combistr
x = x + 1
Next n
Next m
Next k
Next j
Next i
'Hex to Decimal conversion.
x = UBound(Combis)
For i = 1 To x
OriginalString = Combis(i, 0)
NewString = ""
For k = 1 To 5
NewString = NewString & wf.Hex2Dec(Mid(OriginalString, k, 1)) & ","
Next k
Combis(i, 0) = Left(NewString, Len(NewString) - 1)
Next i
'The following writes the array to column A:
With Range("A1").Resize(x)
.Value = Combis
End With
'Now sort randomly (you can comment out this block to retain an ordered list):
With Range("B1").Resize(x)
.Formula = "=rand()"
.Value = .Value
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1").Resize(x, 2)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
Sub GetPermutation(x As String, y As String)
'http://www.mrexcel.com/forum/showthread.php?p=2827068
'from:http://j-walk.com/ss/excel/tips/tip46.htm
' The source of this algorithm is unknown
Dim i As Integer, j As Integer
j = Len(y)
If j < 2 Then
'Cells(CurrentRow, 1) = x & y
Combis(CurrentRow, 0) = x & y
CurrentRow = CurrentRow + 1
Else
For i = 1 To j
Call GetPermutation(x + Mid(y, i, 1), Left(y, i - 1) + Right(y, j - i))
Next
End If
End Sub