Solved

Factorial in VBA

Posted on 2004-10-25
3,973 Views
Last Modified: 2011-09-20
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
    26 Comments
     

    Author Comment

    by:jagatmaniam
    hi all..

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


    Q_21180529
    0
     

    Expert Comment

    by:otanz
    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

    by:huntersvcs
    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

    by:Rick_Townsend
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:Rick_Townsend
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:Rick_Townsend
    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

    by:jagatmaniam
    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

    by:jagatmaniam
    u there rick
    ..is ething fine there...hows ur wife...
    0
     
    LVL 4

    Expert Comment

    by:Rick_Townsend
    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

    by:Rick_Townsend
    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

    by:Rick_Townsend
    '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

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

    by:Rick_Townsend
    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

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

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
    Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
    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 …
    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…

    856 members asked questions and received personalized solutions in the past 7 days.

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

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now