# How to create a permutation algorithm or VB script

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
###### Who is Participating?

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

PS
0

Commented:
0

Author Commented:
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

Commented:
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 Commented:
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 Commented:
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

Commented:
... 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

Commented:
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 Commented:
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 Commented:
I appreciate all your help thus far.
0

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

Commented:
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 Commented:
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 Commented:
Hey Bill, I verified the first 26 rows up above and they are all correct.  How did you generate?
Paul
0

Commented:
>> 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 Commented:
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

Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.