Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
 
Posts: n/a
Default Help with Amending this Code Please

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 =3D 65001 Then
Combinations =3D 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 =3D Range("A1:A20").Value
SubSet =3D 5
SepChar =3D "-"

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

ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)

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

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

Application.ScreenUpdating =3D False

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

SepChar
Next Counter2
DestRange.Offset(Counter1 - 1) =3D Left(NewComb, Len(N=ADewComb) -
_
Len(SepChar))
CountOff(SubSet) =3D CountOff(SubSet) + 1
Dummy =3D SubSet
While Dummy 1
If CountOff(Dummy) MaxOff(Dummy) Then
CountOff(Dummy - 1) =3D CountOff(Dummy - 1) + =AD1
For Counter2 =3D Dummy To SubSet
CountOff(Counter2) =3D CountOff(Counter2 -=AD 1) + 1
Next Counter2
End If
Dummy =3D Dummy - 1
Wend
Next Counter1

Application.ScreenUpdating =3D True
End Sub

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

  #2   Report Post  
Bernie Deitrick
 
Posts: n/a
Default

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


wrote in message
oups.com...
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


  #3   Report Post  
 
Posts: n/a
Default

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

  #4   Report Post  
Bernie Deitrick
 
Posts: n/a
Default

Paul,

Use:

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

HTH,
Bernie
MS Excel MVP

wrote in message
oups.com...
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



  #5   Report Post  
 
Posts: n/a
Default

Hi Bernie,

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

All the Best
Paul

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Trim function doesn't clean out ASCII Code 160 (Space) Ronald Dodge Excel Worksheet Functions 6 January 27th 05 03:48 AM
Command Button VBA code Dave Peterson Excel Discussion (Misc queries) 2 January 25th 05 11:28 PM
Often-Used Code not working in a new Workbook Steve Excel Discussion (Misc queries) 2 December 16th 04 11:55 PM
Zip Code Macro Ken Wright Excel Worksheet Functions 0 December 9th 04 07:55 AM
Problem with Date format from VBA code twig Excel Discussion (Misc queries) 3 December 7th 04 06:01 PM


All times are GMT +1. The time now is 07:22 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"