Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
Hi Bernie,
Brilliant, It Works Perfect. Thanks for All your Help. All the Best Paul |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Trim function doesn't clean out ASCII Code 160 (Space) | Excel Worksheet Functions | |||
Command Button VBA code | Excel Discussion (Misc queries) | |||
Often-Used Code not working in a new Workbook | Excel Discussion (Misc queries) | |||
Zip Code Macro | Excel Worksheet Functions | |||
Problem with Date format from VBA code | Excel Discussion (Misc queries) |