combination

[farasatbalooch]

i want to make numbers combination from 1 to 49
5 numbers combination for example ( 1 2 3 4 5 ) can you
tell me the code it will be a graet help i am using
MS EXCEL 2013.

thanks.

 

[farasatbalooch]

You may want to take a look here, in which Bill Jelen addresses your question.

I have use this code but it's for six numbers combination from 1 to 44 and I want to make 5 numbers combination from 1 to 49 numbers and I have tried this code but it's not working.

 

[Joe4]

I have use this code but it's for six numbers combination from 1 to 44 and I want to make 5 numbers combination from 1 to 49 numbers and I have tried this code but it's not working.

Your code is not quite the same as his. If you his code to your requirements, it will look like this:

Sub ListThemAll()
    TC = 1
    TR = 1
    Ctr = 1
    MaxRows = Rows.Count
    EndCell = 1906884
    Application.ScreenUpdating = False
    For a = 1 To 45
    For b = (a + 1) To 46
    For c = (b + 1) To 47
    For d = (c + 1) To 48
    For e = (d + 1) To 49
    Application.StatusBar = Ctr & " on way to " & EndCell
    Cells(TR, TC).Value = a & "-" & b & "-" & c & "-" & d & "-" & e
    Ctr = Ctr + 1
    If Ctr Mod 25000 = 0 Then
        Cells(TR - 20, TC).Select
        Application.ScreenUpdating = True
        ThisWorkbook.Save
        Application.ScreenUpdating = False
    End If
    TR = TR + 1
    If TR = MaxRows Then
        TR = 1
        TC = TC + 1
    End If
    Next e
    Next d
    Next c
    Next b
    Next a
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

Note that he said this code will probably take over an hour to run - so you will need to be patient!

He added a step that saves the file after every 25000 rows. So if you are unsure if the code is still running, go out to Windows Explorer, navigate to where this file is stored, and look at the last saved/updated date. If it is after the time you started running the code, the code is still running!

 

[farasatbalooch]

Your code is not quite the same as his. If you his code to your requirements, it will look like this:

Sub ListThemAll()
    TC = 1
    TR = 1
    Ctr = 1
    MaxRows = Rows.Count
    EndCell = 1906884
    Application.ScreenUpdating = False
    For a = 1 To 45
    For b = (a + 1) To 46
    For c = (b + 1) To 47
    For d = (c + 1) To 48
    For e = (d + 1) To 49
    Application.StatusBar = Ctr & " on way to " & EndCell
    Cells(TR, TC).Value = a & "-" & b & "-" & c & "-" & d & "-" & e
    Ctr = Ctr + 1
    If Ctr Mod 25000 = 0 Then
        Cells(TR - 20, TC).Select
        Application.ScreenUpdating = True
        ThisWorkbook.Save
        Application.ScreenUpdating = False
    End If
    TR = TR + 1
    If TR = MaxRows Then
        TR = 1
        TC = TC + 1
    End If
    Next e
    Next d
    Next c
    Next b
    Next a
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

Note that he said this code will probably take over an hour to run - so you will need to be patient!

He added a step that saves the file after every 25000 rows. So if you are unsure if the code is still running, go out to Windows Explorer, navigate to where this file is stored, and look at the last saved/updated date. If it is after the time you started running the code, the code is still running!

Thanks sir this code works for me I really appreciate your co operation thanks alot sir

 

[Joe4]

You are welcome.
I am glad it works for you.

Out of curiosity, how long did it take this version to complete running for you?

 

[farasatbalooch]

Ok,

You are welcome.
I am glad it works for you.

Out of curiosity, how long did it take this version to complete running for you?

Sir it just take 20 to 30 minutes for all combinations thanks again sir

 

[Joe4]

Ok,

Sir it just take 20 to 30 minutes for all combinations thanks again sir

Nice! Glad to hear that!

In the example Bill had used, it had over 7 million possible combinations.
Yours had just under 2 million, so I was hoping yours would be less than the 1 hour he mentioned.

 

[JGordon11]

By writing to an array in the loops and then the array to the sheet in one step, this runs in about 10 seconds.

Sub ListThemAll()
    Dim t As Double, TC As Long, TR As Long, a As Long, b As Long, c As Long, d As Long, e As Long
    Const rws = 953442
    t = Timer
    ReDim arr(1 To rws, 1 To 2)
    TC = 1
    TR = 1
    
    For a = 1 To 45
        For b = (a + 1) To 46
            For c = (b + 1) To 47
                For d = (c + 1) To 48
                    For e = (d + 1) To 49
                        arr(TR, TC) = a & "-" & b & "-" & c & "-" & d & "-" & e
                        TR = TR + 1
                        If TR = rws + 1 Then
                            TR = 1
                            TC = TC + 1
                        End If
                    Next e
                Next d
            Next c
        Next b
    Next a
    
    [a1].Resize(rws, 2) = arr
    Debug.Print Timer - t & " seconds"
End Sub