Modify Combinations Code

The following code creates every 10 stock ticker combination from the list of 15 total in A3:A17and copies them to a new worksheet. Is there a way to change the code to create every 10, 11, 12, 13, 14 and 15 stock combination?

I would always like 10 to be the minimum number of stocks in each combination. If there are 20 total in the list (A3:A22) than create every 10-20 stock combination..ect

Option Explicit
 
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
 '
 ' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc
 
Sub ListPermutationsOrCombinations()
'Source:   http://www.ozgrid.com/forum/showthread.php?p=148992
'On Sheet1 A1, enter C for Combinations, or P for Permutations
'On Sheet1 A2, enter the number items for each subset
'On Sheet1 A3 and below, list your values
    Dim Rng As Range
    Dim PopSize As Integer
    Dim SetSize As Integer
    Dim Which As String
    Dim n As Double
    Const BufferSize As Long = 4096
     
    Worksheets("Correlations").Range("A1").Select
    Set Rng = Selection.Columns(1).Cells
    If Rng.Cells.Count = 1 Then
        Set Rng = Range(Rng, Rng.End(xlDown))
    End If
     
    PopSize = Rng.Cells.Count - 2
    If PopSize < 2 Then GoTo DataError
     
    SetSize = Rng.Cells(2).Value
    If SetSize > PopSize Then GoTo DataError
     
    Which = UCase$(Rng.Cells(1).Value)
    Select Case Which
    Case "C"
        n = Application.WorksheetFunction.Combin(PopSize, SetSize)
    Case "P"
        n = Application.WorksheetFunction.Permut(PopSize, SetSize)
    Case Else
        GoTo DataError
    End Select
    If n > Cells.Count Then GoTo DataError
     
    Application.ScreenUpdating = False
     
    Set Results = Worksheets.Add
     
    vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
    ReDim Buffer(1 To BufferSize) As String
    BufferPtr = 0
     
    If Which = "C" Then
        AddCombination PopSize, SetSize
    Else
        AddPermutation PopSize, SetSize
    End If
    vAllItems = 0
     
    Application.ScreenUpdating = True
    Exit Sub
     
DataError:
    If n = 0 Then
        Which = "Enter your data in a vertical range of at least 4 cells." _
        & String$(2, 10) _
        & "Top cell must contain the letter C or P, 2nd cell is the Number" _
        & "of items in a subset, the cells below are the values from Which" _
        & "the subset is to be chosen."
         
    Else
        Which = "This requires " & Format$(n, "#,##0") & _
        " cells, more than are available on the worksheet!"
    End If
     MsgBox Which, vbOKOnly, "DATA  ERROR"
    Exit Sub
End Sub
 
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
    Optional SetSize As Integer = 0, _
    Optional NextMember As Integer = 0)
     
    Static iPopSize As Integer
    Static iSetSize As Integer
    Static SetMembers() As Integer
    Static Used() As Integer
    Dim i As Integer
     
    If PopSize <> 0 Then
        iPopSize = PopSize
        iSetSize = SetSize
        ReDim SetMembers(1 To iSetSize) As Integer
        ReDim Used(1 To iPopSize) As Integer
        NextMember = 1
    End If
     
    For i = 1 To iPopSize
        If Used(i) = 0 Then
            SetMembers(NextMember) = i
            If NextMember <> iSetSize Then
                Used(i) = True
                AddPermutation , , NextMember + 1
                Used(i) = False
            Else
                SavePermutation SetMembers()
            End If
        End If
    Next i
     
    If NextMember = 1 Then
        SavePermutation SetMembers(), True
        Erase SetMembers
        Erase Used
    End If
     
End Sub 'AddPermutation
 
Private Sub AddCombination(Optional PopSize As Integer = 0, _
    Optional SetSize As Integer = 0, _
    Optional NextMember As Integer = 0, _
    Optional NextItem As Integer = 0)
     
    Static iPopSize As Integer
    Static iSetSize As Integer
    Static SetMembers() As Integer
    Dim i As Integer
     
    If PopSize <> 0 Then
        iPopSize = PopSize
        iSetSize = SetSize
        ReDim SetMembers(1 To iSetSize) As Integer
        NextMember = 1
        NextItem = 1
    End If
     
    For i = NextItem To iPopSize
        SetMembers(NextMember) = i
        If NextMember <> iSetSize Then
            AddCombination , , NextMember + 1, i + 1
        Else
            SavePermutation SetMembers()
        End If
    Next i
     
    If NextMember = 1 Then
        SavePermutation SetMembers(), True
        Erase SetMembers
    End If
     
End Sub 'AddCombination
 
Private Sub SavePermutation(ItemsChosen() As Integer, _
    Optional FlushBuffer As Boolean = False)
     
    Dim i As Integer, sValue As String
    Static RowNum As Long, ColNum As Long
     
    If RowNum = 0 Then RowNum = 1
    If ColNum = 0 Then ColNum = 1
     
    If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
        If BufferPtr > 0 Then
            If (RowNum + BufferPtr - 1) > Rows.Count Then
                RowNum = 1
                ColNum = ColNum + 1
                If ColNum > 256 Then Exit Sub
            End If
             
            Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
            = Application.WorksheetFunction.Transpose(Buffer())
            RowNum = RowNum + BufferPtr
        End If
         
        BufferPtr = 0
        If FlushBuffer = True Then
            Erase Buffer
            RowNum = 0
            ColNum = 0
            Exit Sub
        Else
            ReDim Buffer(1 To UBound(Buffer))
        End If
         
    End If
     
     'construct the next set
    For i = 1 To UBound(ItemsChosen)
        sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
    Next i
     
     'and  save it in the buffer
    BufferPtr = BufferPtr + 1
    Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation

That will work but everytime I change the value in A2 and run the macro it creates a new worksheet. How can the code be changed to add the groups all to the same worksheet.

Lets call the worksheet with the consolidated data "Combinations"

I appreciate your suggestion but is there a way to re-write the code to avoid the creation of new worksheets? I have to run this procedure hundreds of times and to continuously keep deleting new worksheets that have been created will become tedious

Okay so I guess that will suffice.

I noticed an error in the combination code. If the total number is 15 and the number chosen is 2 then there should be 105 combinations. If the total number is 15 and the number chosen is 3 then there should be 455 combinations.

Each new sheet has 105 and 455 new combinations respectively after running the ListPermutationsOrCombinations code. However when I run the Consolidate code it only combines 455 rows of data instead of 560 rows.

are you saying to remove the + 1?

This is my code and it is not working...

Sub Consolidate()
Dim ws As Worksheet
Dim wsCmb As Worksheet
Dim NC As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Set wsCmb = Sheets("Combinations")
On Error GoTo 0
    If wsCmb Is Nothing Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Combinations"
        Set wsCmb = Sheets("Combinations")
    Else
        wsCmb.UsedRange.Clear
    End If
    
    NC = 1
    
    With wsCmb
    For Each ws In Worksheets
        If ws.Name <> "Correlations" And ws.Name <> "Combinations" Then
            ws.UsedRange.Copy .Cells(1, NC)
            NC = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), _
                SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        End If
    Next ws
    End With
    
Application.ScreenUpdating = True
End Sub

All of the combinations should be in column A

N/M I figured it out. Thanks for your help!