Help with Amending this Code Please

[paul_black27]

Leo Heuser Posted this Code in 2002, which Works Very Well.
Ideally, I would like this Code to be Amended so that it can List MORE
Than 65,536 Combinations. Maybe List Combinations in the First Column
from A1:A65000 and then Goto Column"B" and Continue.
I know that it Needs Some Sort of Code Like :-

If Combinations = 65001 Then
Combinations = 1
ActiveCell.Offset(-65000, 1).Select
End If

I have Tried Numerous Ways But to NO Avail.
Any Help would be Appreciated.

Here is Leo Heusers Code :-
*****************************************************************
Sub CombinationsFromRange()
Dim DestRange As Object
Dim CountOff()
Dim MaxOff()
Dim CombString As Variant
Dim SepChar As String
Dim NewComb As String
Dim NumOfComb As Long
Dim Dummy
Dim SubSet As Long
Dim NumOfElements As Long
Dim Counter1 As Long
Dim Counter2 As Long

CombString = Range("A1:A20").Value
SubSet = 5
SepChar = "-"

NumOfElements = UBound(CombString)
NumOfComb = Application.Combin(NumOfElements, SubSet)

ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)

For Counter1 = 1 To SubSet
CountOff(Counter1) = Counter1
MaxOff(Counter1) = NumOfElements - SubSet + Counter1
Next Counter1

Worksheets.Add
Set DestRange = Range("a1")

Application.ScreenUpdating = False

For Counter1 = 1 To NumOfComb
NewComb = ""
For Counter2 = 1 To SubSet
NewComb = NewComb & CombString(CountOff(Counter2­), 1) & _

SepChar
Next Counter2
DestRange.Offset(Counter1 - 1) = Left(NewComb, Len(N­ewComb) -
_
Len(SepChar))
CountOff(SubSet) = CountOff(SubSet) + 1
Dummy = SubSet
While Dummy > 1
If CountOff(Dummy) > MaxOff(Dummy) Then
CountOff(Dummy - 1) = CountOff(Dummy - 1) + ­1
For Counter2 = Dummy To SubSet
CountOff(Counter2) = CountOff(Counter2 -­ 1) + 1
Next Counter2
End If
Dummy = Dummy - 1
Wend
Next Counter1

Application.ScreenUpdating = True
End Sub

--
Best regards
Leo Heuser
MVP Excel
*****************************************************************
Thanks in Advance.
All the Best
Paul

 

[Bernie Deitrick]

Paul,

Add this just below the declarations:

Dim myWrap As Long
myWrap = 10000 ' Select how long you want your columns to be here, with a
max of 65536

And then change the line with the Offset from:

DestRange.Offset(Counter1 - 1) = ......

to

DestRange.Offset((Counter1 Mod myWrap), Int(Counter1 / myWrap)) = ......

HTH,
Bernie
MS Excel MVP


Leo Heuser Posted this Code in 2002, which Works Very Well.
Ideally, I would like this Code to be Amended so that it can List MORE
Than 65,536 Combinations. Maybe List Combinations in the First Column
from A1:A65000 and then Goto Column"B" and Continue.
I know that it Needs Some Sort of Code Like :-

If Combinations = 65001 Then
Combinations = 1
ActiveCell.Offset(-65000, 1).Select
End If

I have Tried Numerous Ways But to NO Avail.
Any Help would be Appreciated.

Here is Leo Heusers Code :-
*****************************************************************
Sub CombinationsFromRange()
Dim DestRange As Object
Dim CountOff()
Dim MaxOff()
Dim CombString As Variant
Dim SepChar As String
Dim NewComb As String
Dim NumOfComb As Long
Dim Dummy
Dim SubSet As Long
Dim NumOfElements As Long
Dim Counter1 As Long
Dim Counter2 As Long

CombString = Range("A1:A20").Value
SubSet = 5
SepChar = "-"

NumOfElements = UBound(CombString)
NumOfComb = Application.Combin(NumOfElements, SubSet)

ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)

For Counter1 = 1 To SubSet
CountOff(Counter1) = Counter1
MaxOff(Counter1) = NumOfElements - SubSet + Counter1
Next Counter1

Worksheets.Add
Set DestRange = Range("a1")

Application.ScreenUpdating = False

For Counter1 = 1 To NumOfComb
NewComb = ""
For Counter2 = 1 To SubSet
NewComb = NewComb & CombString(CountOff(Counter2­), 1) & _

SepChar
Next Counter2
DestRange.Offset(Counter1 - 1) = Left(NewComb, Len(N­ewComb) -
_
Len(SepChar))
CountOff(SubSet) = CountOff(SubSet) + 1
Dummy = SubSet
While Dummy > 1
If CountOff(Dummy) > MaxOff(Dummy) Then
CountOff(Dummy - 1) = CountOff(Dummy - 1) + ­1
For Counter2 = Dummy To SubSet
CountOff(Counter2) = CountOff(Counter2 -­ 1) + 1
Next Counter2
End If
Dummy = Dummy - 1
Wend
Next Counter1

Application.ScreenUpdating = True
End Sub

--
Best regards
Leo Heuser
MVP Excel
*****************************************************************
Thanks in Advance.
All the Best
Paul

 

[paul_black27]

Thanks Bernie,

It Works Except for One Thing, the Combinations Start in Cell "A2" in
the First Column, But in Subsequent Columns they Start in the First Row
which is OK.

Thanks Again.
All the Best
Paul

 

[Bernie Deitrick]

Paul,

Use:

DestRange.Offset(((Counter1 - 1) Mod myWrap), Int((Counter1 - 1) / myWrap))
=

HTH,
Bernie
MS Excel MVP

 

[paul_black27]

Hi Bernie,

Brilliant, It Works Perfect.
Thanks for All your Help.

All the Best
Paul