Needin some VBA code 2

[bluedragon2]

This is not urgent by any means, but I would like to play with some VBA code (that you all know that I am way behind the curve on in excel) that will help me put together a little project I am tinkering with.

So, here is the criteria:

I want to put a number in A1 (ie 123 or 1234 or 12345 and so on)

What I want is for all of the unique combonations of that number of digits. For example, if I enter 123, I want:

123
132
213
231
312
321

Now, I would like for the results to be evenly distributed over 10 columns. Lets say that the input number was 1234567, there would be 7! or 5040 results. I would like the results to be 10 columns of 504 rows.

Blue

 

[KenWright]

Here's some stuff from John Walkenbach to start you off. Throw this lot into a single module and then run GetString:-

Dim CurrentRow

Sub GetString()

'By JOHN WALKENBACH
'The number of permutations of a string is equal to the factorial of the length of
'the string. For example, the word DOG has a length of three -- which means that the
'letters can be rearranged in six different ways: DOG, DGO, ODG OGD, GDO, and GOD. The
'number of permutations quickly gets unwieldy. The table below lists the number of
'permutations for strings of various sizes.
'
'Characters Permutations
'1 1
'2 2
'3 6
'4 24
'5 120
'6 720
'7 5,040
'8 40,320
'9 362,880
'10 3,628,800
'11 39,916,800
'12 479,001,600
'
'This tip describes how to generate all permutations from a string. It uses a recursive
'subroutine to do the work. The source of this algorithm is not known (I was browsing through
'some old files on my hard drive and discovered it).
'

'The GetString subroutine prompts the user for a string. If the length of the string is
'greater than 1 and less than 8, the GetPermutations subroutine is called --which then
'calls itself. The permutations are stored in column A of the worksheet.
'


Dim InString As String
InString = InputBox("Enter text to permute:&quot
If Len(InString) < 2 Then Exit Sub
If Len(InString) >= 8 Then
MsgBox &quot;Too many permutations!&quot;
Exit Sub
Else
ActiveSheet.Columns(1).Clear
CurrentRow = 1
Call GetPermutation(&quot;&quot;, InString)
End If
End Sub

Sub GetPermutation(x As String, y As String)
' The source of this algorithm is unknown
Dim i As Integer, j As Integer
j = Len
If j < 2 Then
Cells(CurrentRow, 1) = x & y
CurrentRow = CurrentRow + 1
Else
For i = 1 To j
Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i))
Next
End If
End Sub

It doesn't spread it across the range you have asked for though, but it will give you all the permutations.

Regards
Ken..................

 

[bluedragon2]

Thanks Ken, looks like a nice learning tool for me

Blue

 

[KenWright]

My pleasure - If you are looking to buy any reference material, John has a great book called:-

Excel 2002 Power Programing with VBA

http://www.amazon.co.uk/exec/obidos...74065/sr=2-1/ref=sr_2_1_1/026-7834420-6324412

Don't be put off by the title though as it starts from scratch. There's not a bad review on the site, and John's style of writing just works for me.

Regards
Ken..............

 

[bluedragon2]

Thanks again Ken,

I added:

rw = 1
For z = 1 To Len(InString) 'Because I don't know the factorial command
rw = rw * z 'And couldn't find it quickly
Next

cl = 1
rwn = 1

For z = 2 To rw

If z = 2 Then
Range(&quot;A2&quot.Select
Selection.Cut
Range(&quot;B1&quot.Select
ActiveSheet.Paste
cl = cl + 1
Else
Range(&quot;A&quot; & z).Select
Selection.Cut
Cells(rwn, cl).Select
ActiveSheet.Paste
End If

cl = cl + 1
If cl = 11 Then
cl = 1
rwn = rwn + 1
End If

Next

To break it up into 10 rows. May have been the long way about it, but it works

Now I am going to play with it to see if I can get more then 7 permutations.

Blue

 

[Bowers74]

Hey bluedragon2,

I was surfing a bit, just to see what there is to see and I found the following file. I thought immediately on this thread and had a devil of a time finding it again because the keaword search for &quot;Permutate&quot; doesn't find anything in any of the Tek-Tips forums.

This link is a download link to a ZIP file that contains an Excel 5 Workbook, that deals with Permutation of values it can do permutations for strings longer than 7. I think that you might enjoy it.

http://www.geocities.com/SiliconValley/7043/ue.zip

Good Luck!



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[bluedragon2]

Thanks Mike, but I am getting a page unavailable for that link.

If you want, you could send it to my e-mail:

bluedragon_2@yahoo.com

Thanks,

Blue

 

[Bowers74]

Just Right-Click the link and select &quot;Save Target As...&quot; ;-)


Peace!

Mike

Never say Never!!!
Nothing is impossible!!!

 

[bluedragon2]

NOOOOOO, you gave me the solution of what I was trying to create..

Neat little sheet.

Thanks Mike

Blue

 

[Bowers74]

I though you might like it!



Peace!

Mike

Never say Never!!!
Nothing is impossible!!!