Thanks:  0
Likes:  0

Thread: August Challenge of the Month Discussion

1. 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. 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
Else
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

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
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. 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. “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. Hi,

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.

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. 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. OOoo, and another

895.39
83.06
507.08
230.72
911.45
329.17
673.47
228.31
698.27

8. 192.65
194.58
444.98
630.92
978.53
144.77
329.17
116.14
718.32
441.43
365.43

9. 764.18
673.47
228.31
185.58
925.39
722.73
691.83
365.43

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

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

User Tag List

Posting Permissions

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