http://www.excelforum.com/

Solved

Posted on 2010-01-04

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

Configurator---Calculator.jpg

17 Comments

http://www.excelforum.com/

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

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)).

Application.WorksheetFunct

Application.ScreenUpdating

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

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

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

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

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.

Please see the attached excel sheet?

Copy-of-FigureNumber.xlsx

Copy-of-FigureNumber.xlsx

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

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

Paul

Paul

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

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.

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

For i1 = 4 To ws1.Cells(Cells.Rows.Count

For i2 = 4 To ws1.Cells(Cells.Rows.Count

For i3 = 4 To ws1.Cells(Cells.Rows.Count

For i4 = 4 To ws1.Cells(Cells.Rows.Count

For i5 = 4 To ws1.Cells(Cells.Rows.Count

For i6 = 4 To ws1.Cells(Cells.Rows.Count

For i7 = 4 To ws1.Cells(Cells.Rows.Count

For i8 = 4 To ws1.Cells(Cells.Rows.Count

For i9 = 4 To ws1.Cells(Cells.Rows.Count

For i10 = 4 To ws1.Cells(Cells.Rows.Count

For i11 = 4 To ws1.Cells(Cells.Rows.Count

For i12 = 4 To ws1.Cells(Cells.Rows.Count

For i13 = 4 To ws1.Cells(Cells.Rows.Count

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

End Sub

~bp

Title | # Comments | Views | Activity |
---|---|---|---|

sumHeights2 challenge | 7 | 51 | |

VBA if cell is empty msg box and stop program | 3 | 24 | |

Macro to create Bar charts | 4 | 49 | |

countPairs challenge | 7 | 39 |

Join the community of 500,000 technology professionals and ask your questions.

Connect with top rated Experts

**16** Experts available now in Live!