LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #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

 
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 05:04 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"