modify a macro by a bit?

[excelNewbie22]

hi!
johnnyL helped me in this thread macro edit for generate 5 out of 6
can anyone help me modify it again?
to do exactly the same, just instead of 5 of 6, 4 out of 6?

i tried myself, but no luck
here's what i tried: (error in line 9)

Sub excelNewbie22V2()
'
    Dim InputNumbersRow             As Long
    Dim LastRow                     As Long, StartRow                       As Long
    Dim SourceArray()               As Long, OutputArray(1 To 6, 1 To 15)    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, 4)                                                 ' Load SourceArray with all non repeating 4 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 + 15                                                       '   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 15                                              '       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)
                    Case 7: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 7)
                    Case 8: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 8)
                    Case 9: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 9)
                    Case 10: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 10)
                    Case 11: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 11)
                    Case 12: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 12)
                    Case 13: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 13)
                    Case 14: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 14)
                    Case 15: OutputArray(SourceArrayRow, SourceArrayColumn) = _
                            InputNumbersArray(InputNumbersRow, 15)
                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

and here's the original:

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]

my bad, read wrong, not in line 9
but run-time error 9
subscript out of range

Select Case SourceArray(SourceArrayRow, SourceArrayColumn)

 

[excelNewbie22]

no more need, did the long way...

 

[johnnyL]

Is this what you were looking for a sample output?

Book1
	A	B	C	D	E	F	G	H	I	J	K
1
2	1	2	3	4	5	6
3							1	2	3	4
4							1	2	3	5
5							1	2	3	6
6							1	2	4	5
7							1	2	4	6
8							1	2	5	6
9							1	3	4	5
10							1	3	4	6
11							1	3	5	6
12							1	4	5	6
13							2	3	4	5
14							2	3	4	6
15							2	3	5	6
16							2	4	5	6
17							3	4	5	6
18	7	8	9	10	11	12
19							7	8	9	10
20							7	8	9	11
21							7	8	9	12
22							7	8	10	11
23							7	8	10	12
24							7	8	11	12
25							7	9	10	11
26							7	9	10	12
27							7	9	11	12
28							7	10	11	12
29							8	9	10	11
30							8	9	10	12
31							8	9	11	12
32							8	10	11	12
33							9	10	11	12
34	4	11	12	14	15	22
35							4	11	12	14
36							4	11	12	15
37							4	11	12	22
38							4	11	14	15
39							4	11	14	22
40							4	11	15	22
41							4	12	14	15
42							4	12	14	22
43							4	12	15	22
44							4	14	15	22
45							11	12	14	15
46							11	12	14	22
47							11	12	15	22
48							11	14	15	22
49							12	14	15	22
50
Sheet1

 

[excelNewbie22]

wow!
johnnyL
even thought i didn't need it anymore, you helped,
thanks a lot!

 

[excelNewbie22]

forget to ask.... just in case... the macro?

 

[johnnyL]

Here you go:

Sub excelNewbie22V4Of6()
'
    Dim AmountOfNumbersChosen   As Long, MaxAmountOfNumbers     As Long
    Dim InputNumbersRow         As Long, OutputRow              As Long
    Dim StartRow                As Long, LastRow                As Long
    Dim SourceArrayColumn       As Long, SourceArrayRow         As Long
    Dim SourceArray()           As Long, OutputArray()          As Long
    Dim OutputColumn            As String
    Dim InputNumbersArray       As Variant
'
    AmountOfNumbersChosen = 4                                                           ' <--- Set this to the AmountOfNumbersChosen
    MaxAmountOfNumbers = 6                                                              ' <--- Set this to the MaxAmountOfNumbers
    StartRow = 2                                                                        ' <--- Set this to the starting row of numbers to use
    OutputColumn = "G"                                                                  ' <--- Set this to the Column letter to display results to
'
    SourceArray = GetCombinations(MaxAmountOfNumbers, AmountOfNumbersChosen)            ' Load SourceArray with all non repeating 4 out of 6 combinations
'
    ReDim OutputArray(1 To UBound(SourceArray, 1), 1 To UBound(SourceArray, 2))         ' Set the number of rows and columns of OutputArray
'
    LastRow = Range("A" & Rows.Count).End(xlUp).Row                                     ' Get last row # of numbers to use
'
    InputNumbersArray = Range("A" & StartRow & ":F" & LastRow)                          ' Load numbers to use to InputNumbersArray
'
    Range("A" & StartRow & ":F" & LastRow).ClearContents                                ' Erase the numbers to use range
'
    OutputRow = StartRow - UBound(SourceArray, 1)                                       ' Initialize OutputRow
'
    For InputNumbersRow = LBound(InputNumbersArray, 1) To UBound(InputNumbersArray, 1)  ' Loop through the rows of numbers to use
        OutputRow = OutputRow + UBound(SourceArray, 1)                                  '   Increment the OutputRow
'
        Range("A" & OutputRow).Resize(1, MaxAmountOfNumbers) = 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 UBound(SourceArray, 1)                                '   Loop through rows of the SourceArray
            For SourceArrayColumn = 1 To UBound(SourceArray, 2)                         '       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(SourceArray, 1), _
                UBound(SourceArray, 2)).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

That will make it easier for you to to modify, if you need to.

 

[excelNewbie22]