25 items are approx 33.5million combinations, which it just copes with in about 3 minutes. 26 numbers is approx 67million - 20 minutes, 30 is over a billion I'd guess at 24hrs!
Printable View
25 items are approx 33.5million combinations, which it just copes with in about 3 minutes. 26 numbers is approx 67million - 20 minutes, 30 is over a billion I'd guess at 24hrs!
One way would be to temporarlily remove numbers that couldn't possibly be a part of the payment (large numbers for instance). But when you have negatives that could be a problem, which is why negatives are bad!
thats what i thought. its hard to determine which ones dont belong to the payment. i suppose it still has a use for say 20 items. BTW, how do you determine the number of calcs necessary?
Google "how many combinations of 30 numbers" :thumb
Try a large one where you can leave it running over night. Put the lines in red into the code and it will show the number of seconds it took to do it (the Solvit code is in the mod_General module):
Code:Sub SolvIt()
Dim lr As Long, i As Long, rw As Long, shS As Worksheet, shD As Worksheet, ar, rw2 As Long, res As Long, _
j As Long, cl As Long, n As Boolean, tm as Double
tm = Timer
n = True
If Range("L2") = "True" Then n = False
Set shS = shMain
Set shD = shData
If shS.Range("C5") = "" Then MsgBox "It looks like you have no data to match, C5 is empty!": Exit Sub
If IsError(shS.Range("F3")) Then
MsgBox "It looks like you have no Check to match, F3 is empty!"
shS.Range("F3").Select
Exit Sub
End If
If shS.Range("F3") = "" Then
MsgBox "It looks like you have no Check to match, F3 is empty!"
shS.Range("F3").Select
Exit Sub
End If
lr = shD.Cells(Rows.Count, 3).End(xlUp).Row
shD.Range("C4:C" & lr).ClearContents
shD.Range("D1:D10").ClearContents
lr = shS.Cells(Rows.Count, 3).End(xlUp).Row
shS.Range("C5:C" & lr).Copy shD.Range("C4")
shD.Range("G2:Q1000").ClearContents
With shD
.Activate
lr = .Cells(.Rows.Count, 3).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("C4:C" & lr), SortOn:=xlSortOnValues, Order:=xlAscending
.Sort.SetRange .Range("C4:C" & lr)
.Sort.Apply
For i = 4 To lr
If .Cells(i, 3) > 0 Then Exit For
Next
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("C" & i & ":C" & lr), SortOn:=xlSortOnValues, Order:=xlDescending
.Sort.SetRange .Range("C" & i & ":C" & lr)
.Sort.Apply
.Range("C2:C" & lr).Select
End With
startSearch
frmWrkng.Label1 = "Sorting data..."
DoEvents
res = shD.Cells(Rows.Count, 4).End(xlUp).Row
If res = 1 Then GoTo NoneFound
If res = 2 Then GoTo Only1
cl = 7
For j = 2 To res
ar = Split(shD.Cells(j, 4), ",")
rw2 = 2
For i = LBound(ar) To UBound(ar)
For rw = 5 To lr + 1
If shS.Cells(rw, 3) = shD.Cells(ar(i) + 3, 3) Then
shD.Cells(rw2, cl) = shS.Cells(rw, 1)
shD.Cells(rw2, cl + 1) = shS.Cells(rw, 2)
shD.Cells(rw2, cl + 2) = shS.Cells(rw, 3)
rw2 = rw2 + 1
End If
Next
Next
cl = cl + 4
Next
frmMulti.Show
res = frmMulti.Tag
Only1:
shS.Activate
ar = Split(shD.Cells(res, 4), ",")
rw2 = 5
For i = LBound(ar) To UBound(ar)
For rw = 5 To lr + 1
If shS.Cells(rw, 3) = shD.Cells(ar(i) + 3, 3) Then
If n Then shS.Cells(rw2, 6) = shS.Cells(rw, 1)
If n Then shS.Cells(rw2, 7) = shS.Cells(rw, 2)
If n Then shS.Cells(rw2, 8) = shS.Cells(rw, 3)
rw2 = rw2 + 1
shS.Range("A" & rw & ":D" & rw).Select
Selection.Interior.ColorIndex = 44
shS.Cells(rw, 4) = "X"
End If
Next
Next
Range("F3").Select
Msgbox Timer - tm
Exit Sub
NoneFound:
MsgBox "Sorry, no invoices matched the Check Value.", , "Oops!"
shS.Activate
Range("F3").Select
End Sub
thanks. ill give it a try.
When I tried with 30 positive numbers and 2 negatives (the -$3,175.89 list with some random ones I added), I got 357 unique combinations in 2.5hrs! How are you supposed to pick the correct one out of those?
I have limited the search to the first 10 it finds and it found those 10 combinations in under 10 seconds!
As soon as I took out the two negatives I got 4 combinations in 3 seconds.
I'd bank the cheque, then send the customer either a list of what you've allocated the money to or a list of outstanding and ask them to tick off what they've paid!
Anyway, latest version attached.
Cheers