macro edit for generate 5 out of 6

[excelNewbie22]

hi!

is it possible to edit this macro here

generate combinations of a string and push the others down?

hi! how can I generate all combinations (120) of string of 5 numbers separated by hyphen in a2 but only below it, and also push the next string in a3 (and a4 and a5 and etc) to cell a121 and again, generate all combinations of a121 below it and push the next strings in a122 (and a123 and etc)...

www.mrexcel.com

to generate just all combinations of 5 out of 6 (total of 6 each) with no repeats
for example 1-2-3-4-5-6

1,2,3,4,5
1,2,3,4,6
1,2,3,5,6
1,2,4,5,6
1,3,4,5,6
2,3,4,5,6

 

[johnnyL]

Ok, the following should work for you:

Sub excelNewbie22V2()
'
    Dim InputNumbersRow             As Long
    Dim LastRow                     As Long, StartRow                       As Long
    Dim SourceArray()               As Long, OutputArray(1 To 6, 1 To 5)    As Long
    Dim OutputRow                   As Long
    Dim SourceArrayColumn           As Long, SourceArrayRow                 As Long
    Dim OutputColumn                As String
    Dim InputNumbersArray           As Variant
'
    StartRow = 2                                                                        ' <--- Set this to the starting row of numbers to use
    OutputColumn = "G"                                                                  ' <--- Set this to the Column letter to display results to
    LastRow = Range("A" & Rows.Count).End(xlUp).Row                                     ' Get last row # of numbers to use
    SourceArray = GetCombinations(6, 5)                                                 ' Load SourceArray with all non repeating 5 out of 6 combinations
'
    InputNumbersArray = Range("A" & StartRow & ":F" & LastRow)                          ' Save numbers to use to InputNumbersArray
'
    Range("A" & StartRow & ":F" & LastRow).ClearContents                                ' Erase the numbers to use range
'
    OutputRow = -4                                                                      ' Initialize OutputRow
'
    For InputNumbersRow = LBound(InputNumbersArray, 1) To UBound(InputNumbersArray, 1)  ' Loop through the rows of numbers to use
        OutputRow = OutputRow + 6                                                       '   Increment the OutputRow
'
        Range("A" & OutputRow).Resize(1, 6) = Array(InputNumbersArray(InputNumbersRow, 1), _
                InputNumbersArray(InputNumbersRow, 2), InputNumbersArray(InputNumbersRow, 3), _
                InputNumbersArray(InputNumbersRow, 4), InputNumbersArray(InputNumbersRow, 5), _
                InputNumbersArray(InputNumbersRow, 6))                                  '   Display row of numbers to use to the sheet
'
        OutputRow = OutputRow + 1                                                       '   Increment the OutputRow
'
        For SourceArrayRow = 1 To 6                                                     '   Loop through rows of the SourceArray
            For SourceArrayColumn = 1 To 5                                              '       Loop through columns of the SourceArray
                Select Case SourceArray(SourceArrayRow, SourceArrayColumn)
                    Case 1: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 1)                       '               Perform replacement array values ...
                    Case 2: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 2)
                    Case 3: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 3)
                    Case 4: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 4)
                    Case 5: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 5)
                    Case 6: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 6)
                End Select
            Next                                                                        '       Loop back
        Next                                                                            '   Loop back
'
        Range(OutputColumn & OutputRow).Resize(UBound(OutputArray), 5).Value = OutputArray  '   Display results to sheet
    Next                                                                                ' Loop back
End Sub


Function GetCombinations(lNumber As Long, lNoChosen As Long) As Long()

    Dim lOutput() As Long, lCombinations As Long
    Dim i As Long, j As Long, k As Long
   
    lCombinations = WorksheetFunction.Combin(lNumber, lNoChosen)
    ReDim lOutput(1 To lCombinations, 1 To lNoChosen)
   
    For i = 1 To lNoChosen
        lOutput(1, i) = i
    Next i
   
    For i = 2 To lCombinations
        For j = 1 To lNoChosen
            lOutput(i, j) = lOutput(i - 1, j)
        Next j
        For j = lNoChosen To 1 Step -1
            lOutput(i, j) = lOutput(i, j) + 1
            If lOutput(i, j) <= lNumber - (lNoChosen - j) Then Exit For
        Next j
        For k = j + 1 To lNoChosen
            lOutput(i, k) = lOutput(i, k - 1) + 1
        Next k
    Next i
   
    GetCombinations = lOutput
End Function

 

[excelNewbie22]

superb !!!
thanks a lot johnny!

 

[johnnyL]

Glad to help.