Myrna Larson code for Combinations and Permutations not working in Excel 2007 - Overflow Error

PokerJoe

Board Regular
Joined
Aug 27, 2005
Messages
63
I've used the following code in Excel XP with no problems.
Now that I have Excel 2007, I keep getting an "Overflow" error when trying to run the code. Sometimes it will say "Runtime error '6':, Overflow"

When I step through the code (F8) the line that brings up the error is:

If N > Cells.Count Then GoTo DataError

To give an example of what values I'm entering use the following:

Cell A1 = c
Cell A2 = 5
Cells A3 - A17 = A-O (one letter per cell)

Code:
Option Explicit
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
'  Posted by Myrna Larson
'  July 25, 2000
'  Microsoft.Public.Excel.Misc
'  Subject:  Combin
'
'
'Since you asked, here it is. It is generic, i.e. it isn't written specifically
'for a given population and set size, as yours it. It will do permutations or
'combinations. It uses a recursive routine to generate the subsets, one routine
'for combinations, a different one for permutations.
'To use it, you put the letter C or P (for combinations or permutations) in a
'cell. The cell below that contains the number of items in a subset. The Cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.
'You select the top cell, or the entire range and run the sub. The subsets are
'written to a new sheet in the workbook.
'
'
Sub ListPermutations()
  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
  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
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
SOLVED: Re: Myrna Larson code for Combinations and Permutations not working in Excel 2007 - Overflow Error

I was able to find the solution on my own by researching other Excel forums. I can't explain why the code won't work in Excel 2007 as originally posted by Myrna Larson in July/2000.

It worked fine in Excel 97.

The solution is to comment out the line that is giving me problems and run it as stated in the comments within the code.

The line is: If N > Cells.Count Then GoTo DataError

The solution is: 'If N > Cells.Count Then GoTo DataError

or copy the code below as is.

Code:
Option Explicit
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
'  Posted by Myrna Larson
'  July 25, 2000
'  Microsoft.Public.Excel.Misc
'  Subject:  Combin
'
'
'Since you asked, here it is. It is generic, i.e. it isn't written specifically
'for a given population and set size, as yours it. It will do permutations or
'combinations. It uses a recursive routine to generate the subsets, one routine
'for combinations, a different one for permutations.
'To use it, you put the letter C or P (for combinations or permutations) in a
'cell. The cell below that contains the number of items in a subset. The Cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.
'You select the top cell, or the entire range and run the sub. The subsets are
'written to a new sheet in the workbook.
'
'
Sub ListPermutations()
  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
  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
 
Upvote 0
Hi PokerJoe,

The range object's count property returns a long value. The largest value a long data type can hold is 2,147,483,647.

In Excel 2007, the number of rows and columns in a worksheet has been increased. There are now 17,179,869,184 cells on a worksheet, which is too large for the range object's count property to handle. To cater for this a new range object property has been added called CountLarge.

PokerJoe said:
The solution is to comment out the line that is giving me problems and run it as stated in the comments within the code.
Commenting out the line of code just ignores the issue rather than solving it. :) The true solution is to use CountLarge in Excel 2007:
Code:
If N > Cells.CountLarge Then GoTo DataError

I haven't checked the code for any further implications.

Hope that helps...
 
Upvote 0
When I use this code with text strings, the first letter of every combination/permutation is missing.

Any ideas?

e.g.

C
5
ABCDE
FGHIJ
KLMNO
PQRST
UVWXY

results in

BCDE, FGHIJ, KLMNO, PQRST, UVWXY
BCDE, FGHIJ, KLMNO, UVWXY, PQRST
GHIJ, ABCDE, KLMNO, UVWXY, PQRST
etc..
 
Upvote 0
Could someone explain the intuition behind the code below? I am struggling to understand exactly how it works. I think this is the crux of how the addcombination routine itself works?

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

All help greatly appreciated.

Thanks
 
Upvote 0
Hi PokerJoe,

The range object's count property returns a long value. The largest value a long data type can hold is 2,147,483,647.

In Excel 2007, the number of rows and columns in a worksheet has been increased. There are now 17,179,869,184 cells on a worksheet, which is too large for the range object's count property to handle. To cater for this a new range object property has been added called CountLarge.


Commenting out the line of code just ignores the issue rather than solving it. :) The true solution is to use CountLarge in Excel 2007:
Code:
If N > Cells.CountLarge Then GoTo DataError
I haven't checked the code for any further implications.

Hope that helps...
Hi Thank you very much the Countlarge in Excel works . I have been searching and have finally got the solution here. Props!:beerchug:
 
Upvote 0
Hey guys I know this is an old post but it seems to solve an issue i have been working on. whenever i try i get the error "Enter your data in a verticle range of at least 4 cells" Ive tried copying and pasting the data others used, but i get the same error. Im a total excel noob.
 
Upvote 0
I'm quite late to this 'party', but in case you haven't solved the problem, the code was written in 2000, and it won't run without modification for Excel 2007 or later.

To fix this, find this line

If N > Cells.Count Then GoTo DataError


The other possibility is that you haven't selected the rprobably related to the instructions at the top of the code. Assuming you have things set up right (C or P in the top cell, cell below that has the number of items in a set, and each of the members of the population listed successively in the cells below that, the problem may be you haven't selected the right cell(s) when you run the macro.

'To use it, you put the letter C or P (for combinations or permutations) in a
'cell. The cell below that contains the number of items in a subset. The Cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.
'You select the top cell, or the entire range and run the sub. The subsets are
'written to a new sheet in the workbook.
 
Upvote 0
Re: Myrna Larson code for Combinations and Permutations not working in Excel 2019 - Compile Error

New Compile Error in Excel 2019 64-bit


So, I'm trying to run the code posted above in the original post. I corrected the line commented on replacing Cell.Count with Cell.CountLarge.

Now, I'm getting a compile error message with the following line:

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then (The word "Buffer" is highlighted in blue.)

Error Message says: Compile Error Sub or Function Not Defined.

Any advice? Please!
 
Last edited:
Upvote 0
Re: Myrna Larson code for Combinations and Permutations not working in Excel 2019 - Compile Error

That should be a variable declared at the top of your module (as in the code posted). Is it still there?
 
Upvote 0

Forum statistics

Threads
1,223,991
Messages
6,175,818
Members
452,672
Latest member
missbanana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top