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