Solved

# How to create a permutation algorithm or VB script

Posted on 2010-01-04
1,280 Views
Please see attachment.  I am trying to create data sheets with every possible (horizontal) combination.  Anyhelp or suggestions where to start will be greatly appreiated.
Configurator---Calculator.jpg
0
Question by:BajanPaul

LVL 5

Expert Comment

0

Author Comment

The item number must always be a 13 digit combination.  For the example above, I removed over 50+% of the letters.  Is there a script I could write in VB to generate all the possible combinations?  Once I have them, I plan to upload in SQL and query against them for the datasheets.
0

LVL 5

Expert Comment

http://www.codeguru.com/forum/archive/index.php/t-301647.html

If copy combine all the values in one cell, from line 4 in N1, then line 5 in O1, line 6 in P1, etc.  for example, N1 would be "OS001RLNNSNAT", O1 would be "MF113JGLSCTNN", then select these cells and run this code:

Const iIncrement As Integer = 1000
Dim PossPerm() As String
Dim iSize As Long
Dim iPos As Long
Dim myStr As String

Public Sub doAllPerms()
Dim rng As Excel.Range

If TypeName(Selection) <> "Range" Then Exit Sub

For Each rng In Selection.Cells
If Len(rng.Value) > 0 Then
Call MakePermutations(rng)
End If
Next rng
End Sub

Private Sub MakePermutations(rng As Excel.Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim myArr() As Integer
Dim myPerm() As String

Dim i As Long
Dim j As Long

Dim strTemp As String
myStr = rng.Value

ReDim myArr(0 To Len(myStr) - 1)

For i = LBound(myArr) To UBound(myArr)
myArr(i) = i + 1
Next i

iPos = 1
iSize = iIncrement
ReDim PossPerm(1 To iSize)

Call permuts(myArr, LBound(myArr), UBound(myArr) + 1)

If iPos < iSize Then
iSize = iPos
ReDim Preserve PossPerm(1 To iSize)
End If

ReDim myPerm(LBound(PossPerm) To UBound(PossPerm))

For i = LBound(PossPerm) To UBound(PossPerm)
For j = 1 To Len(PossPerm(i))
myPerm(i) = myPerm(i) & Mid(myStr, CInt(Mid(PossPerm(i), j, 1)), 1)
Next j
Next i

rng.Offset(1, 0).Resize(UBound(myPerm)).Value = _
Application.WorksheetFunction.Transpose(myPerm)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub permuts(ByRef myArr() As Integer, k As Integer, n As Integer)
Dim i As Integer
Dim temp As Integer

If (k = n - 1) Then
For i = 0 To n - 1
writeCurrent CStr(myArr(i))
Next i
writeNext
Else
For i = k To n - 1
temp = myArr(k)
myArr(k) = myArr(i)
myArr(i) = temp
Call permuts(myArr, k + 1, n)
temp = myArr(k)
myArr(k) = myArr(i)
myArr(i) = temp
Next i
End If
End Sub

Private Sub writeNext()
iPos = iPos + 1
If iPos > iSize Then
iSize = iSize + iIncrement
ReDim Preserve PossPerm(1 To iSize)
End If
End Sub

Private Sub writeCurrent(s As String)

PossPerm(iPos) = PossPerm(iPos) & s
End Sub

0

Author Comment

If I wanted to combine all rows"Vertically" so for instance,

4    O     S    0
5    M     F    1
6    G     P    2
7                  3
8                  4
9                  6

N1=OMG
O1=SFP
P1=012346
Will this work?

Each Column multiplies against the other
0

Author Comment

I've been playing with the VB code above.  The permutation happens within each column only.  I need the script to recognize each column independently, multiply and output in order.  For example, look at the headings:

Seri    -   Des    -    End    -    Ball    -     CL     -    Ed     -    TP
O              S               0              0             1           R                  L
M              S               0              0             1           R                  L
G              S               0              0             1           R                  L

I hope I am explaining it clearly.

Thanks,
Paul
0

LVL 5

Expert Comment

... I still don't quite understand... the code that I sent works like this... a cell with a value "OMG" would be selected, in N1 for example, select it and run the VBA code, running the VBA code would drop all ther permuatation values below it.
0

LVL 51

Expert Comment

I think you want to do something like this.  I didn't have time to add in all the columns you need, but you would just keep nesting the FOR loops.  In the innermost loop you have access to the value for each of the columns for this permutation.  I popped up a MsgBox, but you could also write these to a set of rows that you are generating.  Hope this helps, I'll check back later tonight and do more if needed.

Public Sub Test()
Dim iA, iB, iC
For iA = 4 To Cells(Cells.Rows.Count, "A").End(xlUp).Row
For iB = 4 To Cells(Cells.Rows.Count, "B").End(xlUp).Row
For iC = 4 To Cells(Cells.Rows.Count, "C").End(xlUp).Row
MsgBox Cells(iA, "A").Value & Cells(iB, "B").Value & Cells(iC, "C").Value
Next
Next
Next
End Sub

~bp
0

Author Comment

You are right, it does work if I want to permutate the column "Seri" by itself.  I want to multiply all the letters within each column.  I also forgot to mention that the permutations cannot repeat and must be in order.

So for instance,

Completed Figure Number
Seri      Des      End      Ball       CL      Ed      TP      "J"      "B"      "K"      "L"      "M"      "N"
O      S      0      0      1      R      L      N      N      S      N      A      T
O      S      1      0      1      R      L      N      N      S      N      A      T
O      S      1      1      1      R      L      N      N      S      N      A      T

I need the output (permutations) structured and not to repeat.

0

Author Comment

I appreciate all your help thus far.
0

Author Comment

Please see the attached excel sheet?
Copy-of-FigureNumber.xlsx
0

LVL 51

Expert Comment

Hmmm, if I read this right your test data will generate 197,492,188,608 rows, is that REALLY what you want???  (I got to that by 3*3*6*6*4*9*11*6*6*11*13*23*13)

Would the first 26 rows generated contain the following, or am I missing somethng?

OS001RLNNSNAT
OS001RLNNSNAN
OS001RLNNSNAP
OS001RLNNSNAM
OS001RLNNSNAY
OS001RLNNSNAZ
OS001RLNNSNAL
OS001RLNNSNAS
OS001RLNNSNAC
OS001RLNNSNAC
OS001RLNNSNAF
OS001RLNNSNAO
OS001RLNNSNAQ
OS001RLNNSNNT
OS001RLNNSNNN
OS001RLNNSNNP
OS001RLNNSNNM
OS001RLNNSNNY
OS001RLNNSNNZ
OS001RLNNSNNL
OS001RLNNSNNS
OS001RLNNSNNC
OS001RLNNSNNC
OS001RLNNSNNF
OS001RLNNSNNO
OS001RLNNSNNQ

~bp
0

Author Comment

Yes.  I was asked to setup a database with all if not most of the figures numbers in it. I am creating a ms access database with a pretty extensive filter on it.  If all the figure numbers are generated then all the possible combinations will be there for the data sheets I am trying to generate.
0

Author Comment

Hey Bill, I verified the first 26 rows up above and they are all correct.  How did you generate?
Paul
0

LVL 51

Expert Comment

>> BajanPaul

I just expanded on the concept in my above post (26175275) and added the remaining columns.

But I don't think generating these permutation in Excel will be effective, it will take a long time and do you really want all 200 billion?  That just seems like way to large a number of rows to be dealing with in Excel or Access to me.

~bp
0

Author Comment

Bill,
I see your point.  The company I work for has been in business for over 50+ and I believe the engineers that setup the original figure # calculator did it like that for a reason, I can only assume to not run out of combinations.
I am supposed to be meeting with Engineering today to see if we can weed down the figure number a bit.  Could you please explain what you have above as I have very limited knowledge of VB and I will try and write the rest myself.  Thanks for your help.
0

LVL 51

Assisted Solution

Here is the code I ran.  But I had to kill it when I used your data it was running too long and generating too many rows in Sheet(2).

Public Sub Test()
Dim i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, iOut
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
iOut = 0
Application.ScreenUpdating = False
For i1 = 4 To ws1.Cells(Cells.Rows.Count, 1).End(xlUp).Row
For i2 = 4 To ws1.Cells(Cells.Rows.Count, 2).End(xlUp).Row
For i3 = 4 To ws1.Cells(Cells.Rows.Count, 3).End(xlUp).Row
For i4 = 4 To ws1.Cells(Cells.Rows.Count, 4).End(xlUp).Row
For i5 = 4 To ws1.Cells(Cells.Rows.Count, 5).End(xlUp).Row
For i6 = 4 To ws1.Cells(Cells.Rows.Count, 6).End(xlUp).Row
For i7 = 4 To ws1.Cells(Cells.Rows.Count, 7).End(xlUp).Row
For i8 = 4 To ws1.Cells(Cells.Rows.Count, 8).End(xlUp).Row
For i9 = 4 To ws1.Cells(Cells.Rows.Count, 9).End(xlUp).Row
For i10 = 4 To ws1.Cells(Cells.Rows.Count, 10).End(xlUp).Row
For i11 = 4 To ws1.Cells(Cells.Rows.Count, 11).End(xlUp).Row
For i12 = 4 To ws1.Cells(Cells.Rows.Count, 12).End(xlUp).Row
For i13 = 4 To ws1.Cells(Cells.Rows.Count, 13).End(xlUp).Row
iOut = iOut + 1
ws2.Cells(iOut, 1).Value = ws1.Cells(i1, 1).Value
ws2.Cells(iOut, 2).Value = ws1.Cells(i2, 2).Value
ws2.Cells(iOut, 3).Value = ws1.Cells(i3, 3).Value
ws2.Cells(iOut, 4).Value = ws1.Cells(i4, 4).Value
ws2.Cells(iOut, 5).Value = ws1.Cells(i5, 5).Value
ws2.Cells(iOut, 6).Value = ws1.Cells(i6, 6).Value
ws2.Cells(iOut, 7).Value = ws1.Cells(i7, 7).Value
ws2.Cells(iOut, 8).Value = ws1.Cells(i8, 8).Value
ws2.Cells(iOut, 9).Value = ws1.Cells(i9, 9).Value
ws2.Cells(iOut, 10).Value = ws1.Cells(i10, 10).Value
ws2.Cells(iOut, 11).Value = ws1.Cells(i11, 11).Value
ws2.Cells(iOut, 12).Value = ws1.Cells(i12, 12).Value
ws2.Cells(iOut, 13).Value = ws1.Cells(i13, 13).Value
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Application.ScreenUpdating = True
End Sub

~bp
0

Accepted Solution

Bill I will give it a try..Thanks for all your help.

PS
0

## Featured Post

### Suggested Solutions

Iteration: Iteration is repetition of a process. A student who goes to school repeats the process of going to school everyday until graduation. We go to grocery store at least once or twice a month to buy products. We repeat this process every mont…
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…