Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
Solved

# Factorial in VBA

Posted on 2004-10-25
Medium Priority
4,125 Views
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
0
Question by:jagatmaniam
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 14
• 10
• +1

Author Comment

ID: 12403037
hi all..

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

Q_21180529
0

Expert Comment

ID: 12403133
See http://www.dogma.net/markn/articles/Permutations/ for an ideal algorithm taken from C++. You'd need to write the VBA version.
0

LVL 11

Expert Comment

ID: 12404434
Actually, you can set up a table to reflect the values you are looking for.  For example:

Column 1:  1234
Column 2:  5678
Column 3:  9012
Column 4:  =CONCATENATE(RC[-3],RC[-2]),RC[-1])

(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.
0

LVL 4

Expert Comment

ID: 12404623
I don't think he was trying to get sequentially larger numbers, where you jagatmaniam?  You were looking for permutations of the 12 digits listed.  The following might be what you're looking for.

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
0

LVL 4

Expert Comment

ID: 12404667
Actually, you probably want the actual number.  Use this in place of the print statement above:

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

Author Comment

ID: 12438521
well guys...thanks for the prompt reply from u all....but i just wanna make sure whether this code will work if there is any repeat in the number...let's say

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......these 3 sets pf alphabets represent 8068,9003,5488....

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
0

LVL 4

Expert Comment

ID: 12438654
Yes, that is what the code I wrote produces.  Full permutation of all four digit numbers that can be generated from the twelve numbers provided.

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".
0

Author Comment

ID: 12450232
hi rick....

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
0

LVL 4

Expert Comment

ID: 12452898
The program I provided hard-coded in the input, and output to the debug window.  It is fairly straight-forward to modify that code to input and output in your desired format.  Post your preferred way of inputting (for example, in cells A1, A2 and A3, as you suggested), and post your preferred way of outputting.  For example, you probably want the numbers output to one column, with 12 thousand rows.
0

Author Comment

ID: 12454942
rick,

like this i've got 3 numbers...8064,9562,9833...these are my inputs....i've tried do it in Microsoft Excel manually...by just copying the cells....i thought i wanna send it to u..maybe u could have a look...but i dun have ur mail add...

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

LVL 4

Expert Comment

ID: 12455424
Ok, I'll work something up and put the spreadsheet on on one of my webspaces.

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

http://www.experts-exchange.com/registerFree.jsp
0

Author Comment

ID: 12455792
rick, 1 more thing...last time i remember that a login a day gives me 5 points....but now i dun receive any more points....so i can earn point by answering questions only rite....but then i get only if my answer is accepted...apart from buying points..are there any other options for me to earn points.....

thanks
0

LVL 4

Expert Comment

ID: 12457559
Members receive 5 points a day, whether or not you log in to EE.  The point maximum is 500 points, so when you reach 500, you stop earning 5 points a day.

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-exchange.com/help.jsp#hi7

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

Author Comment

ID: 12457978
rick...

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

0

LVL 4

Expert Comment

ID: 12487834
Sorry for the slow response.  My wife has been in the hospital since Sunday.

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

LVL 4

Expert Comment

ID: 12488024
Paste this code.  It reads in any items (digits, strings, whatever) from the first row, and then permutes them down column A.  Just change the constant "NumItems" to be the number of items you want to permute.
(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
0

Author Comment

ID: 12516220
Rick,

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

0

LVL 4

Expert Comment

ID: 12519154
Hmm, it should only print four digit numbers.  I'll check it over and see if I can get rid of repetitions, too.
0

Author Comment

ID: 12522251
rick,
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
0

Author Comment

ID: 12582465
u there rick
..is ething fine there...hows ur wife...
0

LVL 4

Expert Comment

ID: 12589861
She's in rehab.  Sorry, can't continue with this now.  If we haven't solved your problem yet, you can post a request in the Community Support forum to have it closed by a moderator.  (That way your points will be refunded.)
0

LVL 4

Expert Comment

ID: 12616447
Had 30 minutes free today at lunch, so I rebuilt the algorithm.  I've generalized it to handle any number of inputs, and permute them at any length.

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
0

LVL 4

Expert Comment

ID: 12616579
'Takes in any number of strings, and permutes them in groups of length four
'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(permuting)) Then
'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() As Integer) As Boolean
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
0

LVL 4

Accepted Solution

Rick_Townsend earned 80 total points
ID: 12616823
My mistake.  My modifications only find duplicates on full permutations.  (i.e.: nPn)  It still doesn't find duplicates for sub permutations (nPr, where r < n).
0

LVL 4

Expert Comment

ID: 12834889
I think I contributed a fair amount.  My last solution does solve the original question as posed.  It almost solves the question as modified by comments from the Author.  The question became far more complicated when he asked for it to not produce duplicates.

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

Author Comment

ID: 12837266
soory guys.....was outstation for a while...i'll accept ur answer now rick...
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The SignAloud Glove is capable of translating American Sign Language signs into text and audio.
This article will show how Aten was able to supply easy management and control for Artear's video walls and wide range display configurations of their newsroom.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future â€¦
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable â€¦
###### Suggested Courses
Course of the Month10 days, 3 hours left to enroll