this is the question number in the Excel forum which i posted earlier

Q_21180529

Solved

Posted on 2004-10-25

Hi everyone...

I've already posted this question in the Excel forum...but i found out that this problem can be overcome through VBA...so that's y i post it here again...i hope someone could help me...

if i have 3 sets of 4 digits numbers...n then wanna permutate all the 12 digits (3 sets x 4 digits) and then wanna list of combinations that can be produced....

so for example: 1234,5678,9012

apart from 1234 being permutated itself...i oso want the 1596 to be displayed as well....u can c here that 1 is from the 1st set, 5 and 6 from the 2nd set, 9 from the 3rd set....

must note that the numbers above repeat, that is 1 and 2, that is in the 1st n 3rd set....so it must overcome the limitation too

thanks

I've already posted this question in the Excel forum...but i found out that this problem can be overcome through VBA...so that's y i post it here again...i hope someone could help me...

if i have 3 sets of 4 digits numbers...n then wanna permutate all the 12 digits (3 sets x 4 digits) and then wanna list of combinations that can be produced....

so for example: 1234,5678,9012

apart from 1234 being permutated itself...i oso want the 1596 to be displayed as well....u can c here that 1 is from the 1st set, 5 and 6 from the 2nd set, 9 from the 3rd set....

must note that the numbers above repeat, that is 1 and 2, that is in the 1st n 3rd set....so it must overcome the limitation too

thanks

26 Comments

Column 1: 1234

Column 2: 5678

Column 3: 9012

Column 4: =CONCATENATE(RC[-3],RC[-2]

(don't know if the english formula is right, I use the german one!)

Column 4 would give you the combined values. each additional row would have a value increase of one.

For example, A1 = 1234

A2 = A1+1

You only have to limit the maximim values in each column in order to prevent repitition.

Sub test()

Dim i, j, k, m As Integer

Dim digits(12) As Integer

digits(0) = 1

digits(1) = 2

digits(2) = 3

digits(3) = 4

digits(4) = 5

digits(5) = 6

digits(6) = 7

digits(7) = 8

digits(8) = 9

digits(9) = 0

digits(10) = 1

digits(11) = 2

For i = 0 To 11

For j = 0 To 11

For k = 0 To 11

For m = 0 To 11

If (i <> j) And (i <> k) And (i <> m) And (j <> k) And (j <> m) And (k <> m) Then

Debug.Print digits(i); digits(j); digits(k); digits(m)

End If

Next m

Next k

Next j

Next i

End Sub

Debug.Print ((digits(i) * 1000) + (digits(j) * 100) + (digits(k) * 10) + digits(m))

8068,9003,5488

in this case, 0,8, has been repeated more than once..so the amount of permutations will be lesser....

rick,

what i meant was: ok let me put in thic was....abcd,efgh,ijkl.....

apart from abcd being permutated 24times itself...i also want aefg or afjk or bijl.....it means that the 3 sets of numbers can be permutated among themselves but the final digt must 4 and not 12....

thanks

There will be 12P4 results (that is, 12 permute 4.)

12P4 = 12!/(12 - 4)! = 12!/8! = 12 * 11 * 10 * 9 = 11,880

So there will be 11, 880 four-digit numbers produced by the algorithm I provided. However, that algorithm does not remove duplicates from the list of permutation results. So, if you provide all twelve digits as 1111,1111,1111 then you will get twelve thousand rows of "1111".

im extremely new to VBA....how am i suppose to insert your code in VBA....how am i supposed to c the output...

1 more thing...u have already keyed in

digits(0) = 1

digits(1) = 2

digits(2) = 3

digits(3) = 4

digits(4) = 5

digits(5) = 6

digits(6) = 7

digits(7) = 8

digits(8) = 9

digits(9) = 0

digits(10) = 1

digits(11) = 2

how am i suppose to enter my inputs then ? izit 1234 in a column or in each column..

thanks

like this i've got 3 numbers...8064,9562,9833..

in the meantime...izit possible if u could generate the output with inputs i had given....it doesnt matter how many cells are used....

1 more thing...my fren wanna join this forum.....but ive tried looking in here..but ething needs to be paid....i joined free only but now i cant find how to register here free....

You can join EE for free by registering as an Expert. Tell your friend to go here:

http://www.experts-exchang

thanks

Having your answer accepted doesn't transfer those points to your free balance. I think you do get some points, but I don't remember how many. (50 points for an accepted answer, maybe?) Expert points, which you receive for accepted answers, are used in granting Expert status and certifications. Expert status is 10,000 expert points.

I think the rule is that when you reach Expert status, if you earned 3,000 points in any single month, you get a free subscription to EE. That means that you get an unlimited points balance for posting questions.

You should be able to track this stuff down in the QA section. Read this:

http://www.experts-exchang

Also check the New Members section at the top of that page for more info.

ya rick, ive already checked the site after i posted the comment...anyway thanks again...

bout the excel...izit ok...coz ive been trying oso but no result is found

thanks

I don't understand what you mean by

> bout the excel...izit ok...coz ive been trying oso but no result is found

To create/run VBA code in Excel, you can go to the Tools menu, Macro, Visual Basic Editor ...

Then right-click on VBAProject in the Project window (upper-left), and select Insert, Module.

You can then paste in the code I posted, and click the Play button. (Or hit F5, or use the Run menu.)

(ie: to permute 16 items, 16P4, you would just put them in cells A1, B1, ... P1, and change NumItems to 16.)

'-------------------------

Sub test()

'Takes in any number of strings, and permutes them in groups of length four

'The number of items to read in and permute across

Const NumItems = 12

Dim items(NumItems) As String

Dim i, j, k, m, n As Integer

Dim row As Long

Dim sheet As Excel.Worksheet

'Get the active sheet

Set sheet = ActiveWorkbook.ActiveSheet

'Read in the items, from cells A1, B1, C1, D1, ...

For n = 1 To NumItems

items(n) = sheet.Cells(1, n)

Next n

'set the start row for the results

row = 3

'Start the permutations

For i = 1 To NumItems

For j = 1 To NumItems

For k = 1 To NumItems

For m = 1 To NumItems

If (i <> j) And (i <> k) And (i <> m) And (j <> k) And (j <> m) And (k <> m) Then

sheet.Cells(row, 1) = items(i) & items(j) & items(k) & items(m)

row = row + 1

'Debug.Print items(i) & items(j) & items(k) & items(m)

End If

Next m

Next k

Next j

Next i

End Sub

Im sorry bout ur wife...is she ok now....im sorry to make u feel bad.....

btw..u just ignore my msg on >bout the excel...izit ok...coz ive been trying oso but no result is found

what i meant was..i tried just to copy the cells....that's alonger, harder and manual way....

ur code works well....i mean the 2nd code u post -Sub test()'Takes in any number of strings, and permutes them in groups of length four

'The number of items to read in and permute across........

But it lists out all the possibilities and the repitations....i know u have metioned to me earlier bout it that ur code lists every number.....it lists 2 digit and 3 digit number as well...and it reaches 65536 cells too!!!!

i just wonder whether the code could be modified to just print out 4 digit numbers only, and then take out the repitations....but i think the repitations will be a bit harder coz if the numbers that i key in...for example 1001,2002,3003 then there will be less number of permutations ....am i rite....

thanks...

jagat

send my regards to ur wife

1 more small matter....lets say rite in i key in numbers in cells A1,B1,C1,D1.....i put 1234,5678,9012 and in D1 i put 1000...i want to make datas in cell A1,B1,C1,D1 turn into blue colour when the value in cell D1 is equal or greater than 1000....

rite now i can make it work for only the field in D1, i cant make it work for a1,b1 and c1.....

shhud we used vba too for it....

dhanks...

jagat

I had to use recursion to generalize the nested for loops, so I've made a few variables global. Normally, this is a bad design decision, but when using recursion it helps to keep the overhead low by reducing the space required on the call stack.

I also fixed it so it won't generate any duplicates. You could have located the duplicates using the old code by sorting your results, but this is faster and more correct.

If you approve of this code, please accept it, rather than having the points refunded. (I don't particularly care about the points, but anyone else looking for VB code to do permutations should be able to find this solution.)

Rick

'ie: Generates nPr results, minus duplicates,

' where n = NumItems, and r = NumPermuted

'The number of items to read in and permute across

Const NumItems = 3

'The number of items to include in the permuted results

Const NumPermuted = 2

'The actual items (each item can be a String, number, digit, ...)

Dim items(NumItems) As String

'The positions of the items being combined for a permutation

Dim permuting(NumPermuted) As Integer

'Output row

Dim row As Long

'Excel sheet to work on

Dim sheet As Excel.Worksheet

Sub main()

Dim n As Integer

'Get the active sheet

Set sheet = ActiveWorkbook.ActiveSheet

'Read in the items, from cells A1, B1, C1, D1, ...

For n = 1 To NumItems

items(n) = sheet.Cells(1, n)

Next n

'Set the start row for the results

row = 3

'Set the initial permuting positions

For n = 1 To NumPermuted

permuting(n) = 1

Next n

'Start the permutations

Call recurse(1)

End Sub

Sub recurse(depth As Integer)

'Recurse through the items

Dim i As Integer

Dim combo As String

For permuting(depth) = 1 To NumItems

'If we are at the base case for the recursion

If (depth >= NumPermuted) Then

'If this is a valid permutation

If (validCombination(permutin

'Combine the items into the final permuted combination

combo = ""

For i = 1 To NumPermuted

combo = combo & items(permuting(i))

Next i

'output the combination to the spreadsheet

sheet.Cells(row, 1) = combo

row = row + 1

End If

Else

'continue the recursion

Call recurse(depth + 1)

End If

Next permuting(depth)

End Sub

Function validCombination(permuting

Dim i, j As Integer

validCombination = False

For i = 1 To NumPermuted

For j = i + 1 To NumPermuted

If (permuting(i) = permuting(j)) Then

'pointing at the same item

Exit Function

ElseIf ((permuting(i) > permuting(j)) And (items(permuting(i)) = items(permuting(j)))) Then

'items at positions i and j are the same, and the combination has already been done

Exit Function

End If

Next j

Next i

validCombination = True

End Function

I don't particularly care about the points (it's only worth 20 pts), but I think the question should be marked answered with last my solution (11/18/2004 12:15PM EST)

By clicking you are agreeing to Experts Exchange's Terms of Use.

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

Safe way to use a password in a bat or cmd file? | 8 | 43 | |

sumHeights challenge | 17 | 35 | |

SPLUNK REST API call to Splunk to create and index? | 2 | 20 | |

File.WriteAllLines problem at random C# ASP.NET | 6 | 24 |

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

Connect with top rated Experts

**17** Experts available now in Live!