Thanks Thanks:  0
Likes Likes:  0
Page 1 of 11 123 ... LastLast
Results 1 to 10 of 110

Thread: August Challenge of the Month Discussion

  1. #1
    . MrExcel's Avatar
    Join Date
    Feb 2002
    Location
    Merritt Island Florida
    Posts
    868
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default

    Post your solutions to the August Challenge of the Month here.

    _________________
    MrExcel.com Consulting

    [ This Message was edited by: MrExcel on 2002-07-31 12:21 ]

  2. #2
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi,

    Not really interested in the CD, but *very* interested in the challenge. This is an awesome question!!!

    First stab at it...still need to make this much more efficient.

    This calls a recursive subroutine to get the cumulative combinations of N things taken 1...K at a time, then loops through the array of data points to determine if the points match the total.

    Since there are 53 (yes, 53) data points to evaluate, I capped the search at up to 8 individual entries. The limit would be 1 billion+ potential outcomes. And since this is a first stab, I didn't want to test it with a full run.

    This is a UDF which writes the answers to a column. If called from Row 1, you can have up to 65,536 unique solutions. The array will likely bomb with any more (else will cut off the rest???).

    The function is called "Invoice Possibilities" and makes the following function calls

    QuickSortVariants -- as posted by Ivan Maola.

    Split97 -- as posted to microsoft.public.excel.programming by Myrna Larson (she is a retired MD and a MS MVP who is awesome). Can be replaced with Split for those using XL 2000 or XP

    Combinations -- with a call to a subroutine RecursiveCombinations. I scoured the Internet to try to find recursive routines for VBA. Many for C and other languages, but I cannot read them. I have a good idea exactly how this works, but not enough of a grasp to explain it yet (soon).

    I do *not* make good use of the sorted set yet. I included it to (eventually) break out of a loop if the subtotal of the combination is greater than the target.

    Also, suppose the target is negative, and all entries are positive. That, and similar possibilities should be tested first and if true, then exit the routine with your answer.

    OK, more on this as it gets refined and as others post. Crticism/suggestions appreciated. If there is a part that can be junked, let me know. Always willing to redo for a good cause.

    Specific questions
    1. Can collections be manipulated like arrays?
    2. Can a collection be transferred wholesale to an array?
    3. Can you delete a collection in one shot?

    OK, here is the code...

    Code:
    Option Explicit
    Dim fn As WorksheetFunction   'standard shortcut to call Excel functions in VBA
    
    Function Invoice_Possibilities(GoalValue As Double, DataSet)
    Set fn = Application.WorksheetFunction
    '''  This assumes that GoalValue is > 0.
    
    ''''''''''''VARIABLE DECLARATIONS'''''''''''''''''''
    '
    ''' First pass through the function arguments.  Text entries are eliminated.
    Dim FirstSet As Variant  '''    Gets the search values (DataSet)
    '                        '''    into a one dimensional array
    
    ''' If DataSet is a range of values then...
    Dim Cell As Range
    Dim FirstCounter  As Integer
    Dim NumNegative As Integer
    
    ''' Second pass through the data is used to find out
    ''' the number of valid entries.  If there are no entries < 0
    ''' all entries greater than the GoalValue are removed.
    ''' Note:  Zero entries are eliminated if target <> 0!!!!  (is not introduced yet)
    Dim SecondSet
    Dim SecondCounter As Integer
    Dim x As Integer  ' counter variable
    
    Dim SolutionArray
    Dim Counter As Double  '''must change to double from long
    
    Dim t As Double, u As Double, v As Double, w As Double
    Dim SubTotSum As Double, AnswerCnt As Long, FinalArray
    Dim s As Integer, strS As String
    
    ''''''''''''DATA PREPARATION -- 1st pass'''''''''''''''''''
    ''' Determine the type of data in the dataset
    ''' and read into array FirstSet
    ''' Array --> "Variant()"
    ''' Range --> "Range"
    
    If TypeName(DataSet) = "Range" Then
        ReDim FirstSet(1 To DataSet.Cells.Count) As Double
        For Each Cell In DataSet
            If IsNumeric(Cell) And Not IsEmpty(Cell) Then
                FirstCounter = FirstCounter + 1
                FirstSet(FirstCounter) = Cell
                If Cell < 0 Then
                    NumNegative = NumNegative + 1
                End If
            End If
        Next Cell
    ElseIf TypeName(DataSet) = "Variant()" Then
        FirstSet = DataSet
    Else
        ' Exit function if values are unworkable
        Invoice_Possibilities = CVErr(xlErrNum)
        Exit Function
    End If
    
    '''  Exit function if no valid entries on first pass
    If FirstCounter = 0 Then
        Invoice_Possibilities = CVErr(xlErrNum)
        Exit Function
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    '''''''''''''SECOND PASS''''''''''''''''''''''''''''
    '
    '
    '''  This should allow us to start with the minimum number of
    '''  choices to loop through.  If there are no negative numbers,
    '''  this will eliminate any impossible values, i.e., > GoalValue.
    '''  Note:  It is not possible to eliminate duplicated numbers.
    '''  Suppose the out-of-balance is 375.00 and there are 3 entries
    '''  of 125.00.  Dropping two duplicates will drop a solution.
    
    If NumNegative Then
        SecondSet = FirstSet ' can't eliminate if negatives exist
    Else
        ReDim SecondSet(1 To UBound(FirstSet) - LBound(FirstSet) + 1)
        For x = LBound(FirstSet) To UBound(FirstSet)
            If FirstSet(x) <= GoalValue Then
                SecondCounter = SecondCounter + 1
                SecondSet(SecondCounter) = FirstSet(x)
            End If
        Next x
        On Error Resume Next
            ReDim Preserve SecondSet(1 To SecondCounter)
        On Error GoTo 0
        Err.Clear
    End If
    '''  Exit function if no valid entries after second pass
    If SecondCounter = 0 Then
        Invoice_Possibilities = CVErr(xlErrNum)
        Exit Function
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    '
    ''''''''''Next step -- find total possibilities'''''
    ''' Need to find the cumulative combinations of N things
    ''' taking R at a time as R goes from 1 to N.  This
    ''' binomial tree is equal to 2^N.  If the "select zero"
    ''' option is not available, there are 2^N - 1 total possible.
    '''
    ''' Each is loaded into its own array
    
    Call QuickSortVariants(SecondSet, LBound(SecondSet), UBound(SecondSet))
    
    t = fn.Min(8, SecondCounter)
    ReDim SolutionArray(1 To t)
    For x = 1 To t
        SolutionArray(x) = Combinations(SecondCounter, x)
    Next x
    
        For u = 1 To t
            For v = 1 To fn.Combin(t, u)
                For w = 0 To fn.Min(fn.Combin(t, u) - 1, u - 1)
                    SubTotSum = SubTotSum + SecondSet(SolutionArray(u)(v)(w))
                    If SubTotSum > GoalValue Then GoTo NextVlist
                Next w
                
                If fn.Round(SubTotSum, 4) = fn.Round(GoalValue, 4) Then
                    AnswerCnt = AnswerCnt + 1
                    If AnswerCnt = 1 Then
                        ReDim FinalArray(1 To AnswerCnt)
                    Else
                        ReDim Preserve FinalArray(1 To AnswerCnt)
                    End If
                    For s = 0 To fn.Max(0, w - 1)
                        strS = strS & SecondSet(SolutionArray(u)(v)(s)) & "| "
                    Next s
                    FinalArray(AnswerCnt) = Left(Trim(strS), Len(Trim(strS)) - 1)
                    strS = ""
                End If
            
    NextVlist:
            SubTotSum = 0
            Next v
        Next u
    
    If AnswerCnt = 0 Then
        Invoice_Possibilities = "no matches found"
    Else
        Invoice_Possibilities = fn.Transpose(FinalArray)
    End If
    End Function
    
    
    
    Function Combinations(ByVal N As Integer, ByVal K As Integer)
    Dim CombinCollection As New Collection
    Dim x As Long
    Set fn = Application.WorksheetFunction
    
    ReDim CombinArray(1 To fn.Combin(N, K))
    
    RecursiveCombinations CombinCollection, N, K, 1, ""
    
    With CombinCollection
        If .Count = 0 Then
            Exit Function
        Else
            For x = .Count To 1 Step -1
                CombinArray(x) = Split97(Left(CombinCollection(x), _
                Len(CombinCollection(x)) - 1), ",")
                
                CombinCollection.Remove (x)
            Next x
        End If
    End With
    Combinations = CombinArray
    End Function
    
    
    
    Sub RecursiveCombinations(CombinCollection, ByVal N As Integer, _
    ByVal K As Integer, ByVal i As Integer, ByVal strArray As String)
    Dim Counter As Double
    
    If K > N - i + 1 Then Exit Sub
    If K = 0 Then
        CombinCollection.Add strArray
        Exit Sub
    End If
    
    RecursiveCombinations CombinCollection, N, K - 1, i + 1, strArray & i & ","
    RecursiveCombinations CombinCollection, N, K, i + 1, strArray
    
    End Sub
    
    
    
    
    Sub QuickSortVariants(vArray As Variant, inLow As Long, inHi As Long)
          
    '''  Routine posted by Ivan F. Maola to MrExcel.com Message Board
    '''  http://www.mrexcel.com/board/viewtop...=16211&forum=2
    '''  Original author unknown
    '''  Comments deleted in code below
    
    
       Dim pivot   As Variant
       Dim tmpSwap As Variant
       
       Dim tmpLow  As Long
       Dim tmpHi   As Long
        
       tmpLow = inLow
       tmpHi = inHi
        
       pivot = vArray((inLow + inHi)  2)
      
       While (tmpLow <= tmpHi)
      
          While (vArray(tmpLow) < pivot And tmpLow < inHi)
             tmpLow = tmpLow + 1
          Wend
          
          While (pivot < vArray(tmpHi) And tmpHi > inLow)
             tmpHi = tmpHi - 1
          Wend
    
          If (tmpLow <= tmpHi) Then
          
             tmpSwap = vArray(tmpLow)
             vArray(tmpLow) = vArray(tmpHi)
             vArray(tmpHi) = tmpSwap
             
             tmpLow = tmpLow + 1
             tmpHi = tmpHi - 1
          End If
       
       Wend
      
       If (inLow < tmpHi) Then QuickSortVariants vArray, inLow, tmpHi
       If (tmpLow < inHi) Then QuickSortVariants vArray, tmpLow, inHi
      
    End Sub
    
    
    
    Function Split97(sString As String, Optional sDelim As String = " ", _
    Optional ByVal Limit As Long = -1, _
    Optional Compare As Long = vbBinaryCompare) As Variant
    
    ''''''''''''''''''''''''''''
    '   Split97 mirrors the Split function introduced in XL2000
    '   Author Myrna Larson
    '   posted to microsoft.public.excel.programming 13 Nov 2001
    
    Dim vOut As Variant, StrLen As Long
    Dim DelimLen As Long, Lim As Long
    Dim N As Long, p1 As Long, p2 As Long
    
    StrLen = Len(sString)
    DelimLen = Len(sDelim)
    ReDim vOut(0 To 0)
    
    If StrLen = 0 Or Limit = 0 Then
     ' return array with 1 element which is empty
    ElseIf DelimLen = 0 Then
        vOut(0) = sString ' return whole string in first array element
    Else
        Limit = Limit - 1 ' adjust from count to offset
        N = -1
        p1 = 1
        
        Do While p1 <= StrLen
            p2 = InStr(p1, sString, sDelim, Compare)
            If p2 = 0 Then p2 = StrLen + 1
            N = N + 1
            If N > 0 Then ReDim Preserve vOut(0 To N)
            If N = Limit Then
                vOut(N) = Mid$(sString, p1) ' last element contains entire tail
                Exit Do
            Else
                vOut(N) = Mid$(sString, p1, p2 - p1) ' extract this piece of string
            End If
                p1 = p2 + DelimLen ' advance start past delimiter
        Loop
    End If
    Split97 = vOut
    End Function
    I haven't finished commenting this, and you'll notice that my variable declarations got a lot less descriptive as I went on -- blame it on laziness.

    _________________
    Bye,
    Jay

    EDIT: Changed the separator to a | from a comma to eliminate confusion with systems having the comma as the decimal separator.

    [ This Message was edited by: Jay Petrulis on 2002-08-02 08:01 ]

  3. #3

    Join Date
    Jul 2002
    Posts
    172
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-07-31 12:08, MrExcel wrote:
    Post your solutions to the August Challenge of the Month here.

    _________________
    MrExcel.com Consulting

    [ This Message was edited by: MrExcel on 2002-07-31 12:21 ]

    Could you post the link to the recent posting on the MS boards that you mentioned, please?

  4. #4

    Join Date
    Jul 2002
    Posts
    172
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    “The August challenge is to document a method for determining which invoices the customer is paying. If there is more than one combination, note that. We are looking for the best general purpose algorithm that could be used every day by accounts receivable departments across the world for similar problems.”


    This is an interesting mental exercise but in the real world, I cannot imagine that it is a necessity or even desirable.
    It involves guessing the payer’s intention. If a match is found that is not made up of the earliest dated invoices, it may not be appropriate to assume that the payer intended to settle these invoices – he may want the payment offset against the earliest invoices.
    In any event, because of the potentially huge number of combinations, I doubt that there is an Excel solution that will prove to be practical.

    Normal practical requirements merely need to set off unallocated payments against the earliest dated invoices (with a partial offset for the last one if necessary) and then to advise the payer to what invoices the payment has been applied.
    It is simple to automate this - both the set-off and the issue of the advice to the payer.
    Even if an exact set off is made, whether or not it is against the earliest invoices, an advice to the payer is still advisable procedure.

    Since earlier invoices are normally settled first, perhaps a partial automated check could be run to try matching the payment with the invoices.
    For example, the combinations could be checked for the earliest invoices that add up to just over the amount paid plus (say) 4-5 invoices. If a match were found, OK – otherwise just set off against the earliest invoices.
    This would remove the potentially impractical processing of huge combinations.

    It’s an interesting challenge, but I don’t think it’s one that has much useful application in the context of managing accounts receivable.

  5. #5
    MrExcel MVP Jay Petrulis's Avatar
    Join Date
    Mar 2002
    Location
    Chicago, IL USA
    Posts
    2,040
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi,

    The link is here...

    http://groups.google.com/groups?hl=e...40tkmsftngxa06

    It is also in my posting to Chris Davison's thread "Longest Macro" in the XL-Lounge from a few days ago.

    This problem won't be "solved" with an algorithm, at least not by anyone using Excel by August 31. This challenge is a "Holy Grail" of computer science. However, that doesn't mean the exercise is of no use. In fact, I think it is highly instructive about using Excel and has a lot of practical use for smaller data sets. So I wouldn't worry too much about how truly applicable this is for the specific problem description.

    Bear in mind Harlan's message in the newsgroup thread that human capacity to find the match(es) far exceeds the capacity of the fastest supercomputer.

    The key part is to try to remove as many combinations as you can. The more you discard the faster the program will run through the valid combinations.

    In Chris' thread, I think PaddyD responded about this being a P=NP (complete or hard???) problem, like the travelling salesman and the knapsack problem.

    BTW, the travelling salesman problem has been solved (...find the shortest route a salesman will take if he is to visit each of the xxxx number of US cities/towns over some threshold population, visiting each locale once). It was done with a distributed grid computer (thousands of linked computers lending their muscle) after two weeks or so of continuous processing!!!!

    Give it a shot. A group effort will result in a routine that will be optimum given our limited resources and abilities (some of the greatest minds in mathematics and computer science have worked on this, so you and I won't get too far). In any event, I learned a ton from the thread and trying the exercise. Case in point -- look at my routine. At the end I am looking at an array containing an array of arrays -- SolutionArray(u)(v)(w). I am sure that that can be improved, but I didn't know how to use arrays in anyway like this manner until I gave it a shot.

    We have a full month to work on this, so the best effort will show some nice progress.

    _________________
    Bye,
    Jay


    [ This Message was edited by: Jay Petrulis on 2002-08-02 21:08 ]

  6. #6
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Millbank, London, UK
    Posts
    1,790
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    how many answers are there ?

    I got one set in about 3 mins running time if it's any help...

    680.23
    98.40
    444.98
    324.84
    978.53
    911.45
    409.17
    718.32

    just a very basic brute-force but random method.... I'll keep tinkering

    [ This Message was edited by: Chris Davison on 2002-08-03 01:04 ]

  7. #7
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Millbank, London, UK
    Posts
    1,790
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    OOoo, and another

    895.39
    83.06
    507.08
    230.72
    911.45
    329.17
    673.47
    228.31
    698.27

  8. #8
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Millbank, London, UK
    Posts
    1,790
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    192.65
    194.58
    444.98
    630.92
    978.53
    144.77
    329.17
    116.14
    718.32
    441.43
    365.43



  9. #9
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Millbank, London, UK
    Posts
    1,790
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    764.18
    673.47
    228.31
    185.58
    925.39
    722.73
    691.83
    365.43

  10. #10
    Board Regular
    Join Date
    Feb 2002
    Posts
    3,186
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi Guys as you know i work in Finanace 15 yers and Debt Recovery / County Courts and all the rest in my times.

    I feel this challenge is a poser, but underline TOTALLY pointless in the cut and thrust on debt, all invoices are debt untill PAID.

    You can never work out what invoices someone will pay in advance its not like that as one bill can be in dispute or not POD fully 1000000 reasons all different or the old i ant goona pay that one till next week, thats where credit contrl comes in of cause.

    In the UK this challenge is i feel against English law, that is as the idea is to work out and prepair people to pay with an system to work out what they wil pay,

    ALL camoants in sales offer terms of payment credit if you like if 1 day COD or 30/ 60 days whatever, so this is the cut line, but remember guys pay in advance so that will make any system fail again

    Ledgers that are cleaverly constructed are able to highlight debt and expected payments no VBA will run to give the correct results as the payer will throw a spanner in the works evertime and you time and effort will never help, on spent time re working the results.

    Finance and debt is risk related so look and new debts and thats what yo need to collect matters not if or how

    say i need £100

    Bill should pay £60
    Juan should pay £14
    Jack should pay £16
    Dave Should pay £30

    Im £20 over but credit management hows i need only £100 the £20 in this case is cream

    But say i get Chris to pay £50 i do not need Daveand Jack to pay.

    So prepairing data is not workable: Debt is collected in terms and out and deals on debts also so thats the wild card

    Only advice i can give is stick to law, and help you debtors and encourage them to pay, polit and friendly is best nOT hostile.

    I collect £1,000,000 or $1,555,000 so my debt reduces that a top heavy collection ie im doing myself out of a job!!! i collect to much, as stastics say - so i do an ok job each month 30 day cycles.

    What would do the best to answer this would be ODBC all debts in invoice format attached required details and then auto mate in letter and reports production, ie send letter or call debtor

    No waht you need to do is report this debt so that you know each day what overdue and you have attacked it, now run that week and then months cross check unpaid to paid to give you collect rate % 60 to 68% is in the zone, or more that current debts occured.

    Then you will have your answers.

    NEVER will 100% be collected unless very few debtors to collect from i have thousands each month, i know most of them thou:

    Also in letters you can trans ISO detail [invoice details] to be fired into letters...


    Free Excel based Web Toolbar available here.

    Jack in the UK
    J & R Excel Solutions
    "making Excel work for you"

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •