August Challenge of the Month Discussion

[richrr31]

I don't think the relevance of the issue is worth discussion. Who cares? It's just fun to try and come up with a solution.....Here is my stab at it, pseudocode only(I have real work to do!)

1. T=The goal in $ N=The number of different entries
2. List all of the values in descending order.
3. If there is one equal to the goal(T) copy that cell to a different sheet. (To obtain the formula of that cell later.)
4. Remove any values that are more than T(they are useless).
5. On a different sheet, make a pyramid, adding the lesser values to the ones greater.

i.e. If the numbers are 4,3,2,1 and the goal is 8, then
4
3
2
1 would be the list, and the pyramid on the next sheet would look like this:

[4+3] [4+2] [4+1]
[3+2] [3+1]
[2+1]

6. Loop back to step 2, making the list separate by rows:
The new list would look like this:

[4+3]
[4+2]
[4+1]
------
[3+2]
[3+1]
------
[2+1]

7. Back to step 3, moving any that are the exact value to a different page(so we can get the formula later), and remove any that are greater than T. The difference however, is to list them separarately by row.

8. Remove all values which can no longer be added to, then perform step 5 again:

[4+3+2] [4+3+1]
[4+2+1]
-----------
[3+2+1]
9. Once again, we would make a new list, separating:
[4+3+2] Deleted(Too Much)
Moved to other sheet:[4+3+1]
---------
[4+2+1] Deleted(no more adds)
---------
[3+2+1] Deleted (no more adds)

10. Move all values equal to T to the other sheet(to get the formula). Delete ones that are over, and remove ones that can't be added to:
In this case there aren't any.....By needing to look for multiple values, this process will take longer than it should. This method, however, checks every possible combo, but never performs an unnecessary calculation(If a combo is too much or exact, no more additions are performed).

When everything is all said and done, the good formulas are located on a separate sheet, uncover the formulas, and you have your answer.

Thanks!

 

[Damon Ostrander]

Solver can be used to find solutions also. The following solution, different from the ones posted so far, took Solver a couple minutes:

895.39
507.08
222.52
192.65
89.40
230.72
911.45
329.17
673.47
228.31
116.14
160.62

To set up solver to do this problem I just used a binary 0 or 1 multiplier on each invoice amount and used Solver to drive the sum of the multiplied amounts to the target (payment received) amount.

When there are multiple solutions, as in this case, different solutions can be obtained with Solver by using different initializations. Of course, Solver has the same problem all the others have--if the list is big it can take a LONG time (is a billion years too long?). I believe Solver's efficiency comes mainly from the fact that it is compiled code--probably written in C.

Cheers to all for the very interesting problem, discussion, and proposed solutions.

 

[Jay Petrulis]

Hi,

Here is a total brute force method, which will likely be very slow.

I named the ranges with the data and the target, and commented out the methods to prompt for them.

I think that the routines by Ioannis and Sharad K. are much nicer (although we've yet to see the code from Ioannis), and the Solver solutions are more elegant than this for sure.

Option Explicit
Dim fn As WorksheetFunction
Public HoldingArray() As Variant

Sub MrExcelChallengeAug2002()
Dim wks As Worksheet
Dim n As Integer, k As Integer, a As Integer, i As Long
Dim Data_Set As Range, Target_Val As Double, Data_to_Use
Dim arrsize As Long

Set fn = Application.WorksheetFunction
Set Data_Set = Range("DataList") 'Application.InputBox("Enter the range of values", , , , , , , :cool:
Target_Val = fn.Round(Range("GoalValue"), 2) 'fn.Round(Application.InputBox("Enter the target value", , , , , , , 9), 2)
Set wks = Worksheets.Add

Data_to_Use = FindValues(Data_Set, Target_Val)
Set Data_Set = Nothing
n = UBound(Data_to_Use) - LBound(Data_to_Use) + 1
'k = fn.Min(7, Find_Max_K(n, Data_to_Use, Target_Val))
k = Find_Max_K(n, Data_to_Use, Target_Val)

ReDim HoldingArray(1 To k)
For a = 1 To k
    Application.StatusBar = a
    If a<= 12 Then
        HoldingArray(a) = Find_Possible(Data_to_Use, Target_Val, n, a)
    ElseIf a<= 18 Then
        HoldingArray(a) = Find_Possible2(Data_to_Use, Target_Val, n, a)
    Else
        HoldingArray(a) = Find_Possible3(Data_to_Use, Target_Val, n, a)
    End If
    arrsize = UBound(HoldingArray(a)) - LBound(HoldingArray(a)) + 1
    If arrsize<= 65536 Then
        wks.Cells(1, a).Resize(arrsize, 1) = fn.Transpose(HoldingArray(a))
    End If
Next a
Application.StatusBar = False
End Sub

Function FindValues(Data_Set, ByVal Target_Val As Double)
Dim FirstCounter As Integer, SecondCounter As Integer
Dim Cell As Range, NumNegative As Integer, SecondSet
Dim x As Integer

If TypeName(Data_Set) = "Range" Then
    ReDim FirstSet(1 To Data_Set.Cells.Count) As Double
    For Each Cell In Data_Set
        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(Data_Set) = "Variant()" Then
    FirstSet = fn.Transpose(Data_Set)
    FirstCounter = UBound(FirstSet) - LBound(FirstSet) + 1
Else
    FindValues = CVErr(xlErrNum)    ' Exit function if values are unworkable
    Exit Function
End If

'''  Exit function if no valid entries on first pass
If FirstCounter = 0 Then
    FindValues = 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., > Target_Val.
'''  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
    SecondCounter = UBound(SecondSet) - LBound(SecondSet) + 1
Else
    ReDim SecondSet(1 To UBound(FirstSet) - LBound(FirstSet) + 1)
    For x = LBound(FirstSet) To UBound(FirstSet)
        If FirstSet(x)<= Target_Val 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
    FindValues = CVErr(xlErrNum)
    Exit Function
End If
Call QuickSortVariants(SecondSet, LBound(SecondSet), UBound(SecondSet))
FindValues = SecondSet
End Function

Function Find_Max_K(nums, Data_Used, TargetValue) As Integer
Dim i As Integer, DataSum As Double
Set fn = Application.WorksheetFunction
    
For i = 1 To nums
    DataSum = DataSum + fn.Round(Data_Used(i), 2)
    If DataSum > TargetValue Then
        Find_Max_K = i - 1
        Exit Function
    End If
Next i
Find_Max_K = nums
End Function


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/viewtopic.php?topic=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

The above is the main driver routine and some auxiliary routines which find the minimum number of entries that you would need to evaluate.

It calls one of 3 routines, depending on the size of the number to select.

I have listed only one of them for space reasons. The others are structured exactly the same way.

Sorry about the length of this...

Function Find_Possible(DataList, ByVal TargetValue As Double, _
ByVal elements As Integer, ByVal numselect As Integer)

Dim SolutionArray, Counter As Double, cnt As Double
Dim SumCounter As Integer, SubtotalSum1 As Double, SubtotalSum2 As Double
Dim SubtotalSum3 As Double, SubtotalSum4 As Double, SubtotalSum5 As Double
Dim SubtotalSum6 As Double, SubtotalSum7 As Double, SubtotalSum8 As Double
Dim SubtotalSum9 As Double, SubtotalSum10 As Double, SubtotalSum11 As Double
Dim SubtotalSum12 As Double, SubtotalSum13 As Double, SubtotalSum14 As Double
Dim SubtotalSum15 As Double, SubtotalSum16 As Double, SubtotalSum17 As Double
Dim SubtotalSum18 As Double, SubtotalSum19 As Double, SubtotalSum20 As Double
Dim SubtotalSum21 As Double
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer
Dim g As Integer, h As Integer, i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer, n As Integer, o As Integer, p As Integer, q As Integer, r As Integer
Dim s As Integer, t As Integer, u As Integer, v As Integer, w As Integer, x As Integer
Set fn = Application.WorksheetFunction

If numselect<= 6 Then ReDim SolutionArray(1 To fn.Combin(elements, numselect)) As String

Select Case numselect
    Case 0
        Counter = Counter + 1
        SolutionArray(1) = 0
    Case elements
        If fn.Sum(DataList) = TargetValue Then
            Counter = Counter + 1
            SolutionArray(1) = DataList
        End If
    Case Is > elements
        Counter = Counter + 1
        SolutionArray(1) = 0
    Case 1
        For a = 1 To elements
            If fn.Round(DataList(a), 2) = TargetValue Then
                Counter = Counter + 1
                SolutionArray(Counter) = DataList(a)
            End If
        Next a
    Case 2
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            If SubtotalSum1 = TargetValue Then
                Counter = Counter + 1
                SolutionArray(Counter) = DataList(a) & " | " & DataList(b)
            End If
        Next b: Next a
    Case 3
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements + 2 - numselect
        For c = b + 1 To elements
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            SubtotalSum2 = fn.Round(SubtotalSum1 + DataList(c), 2)
            If SubtotalSum1 > TargetValue Then GoTo Exit3_1
            If SubtotalSum2 > TargetValue Then
                GoTo Exit3
            ElseIf SubtotalSum2 = TargetValue Then
            Counter = Counter + 1
            SolutionArray(Counter) = DataList(a) & " | " & DataList(b) _
            & " | " & DataList(c)
            End If
        Next c
Exit3:
        Next b
Exit3_1:
        Next a

    Case 4
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements + 2 - numselect
        For c = b + 1 To elements + 3 - numselect
        For d = c + 1 To elements
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            SubtotalSum2 = fn.Round(SubtotalSum1 + DataList(c), 2)
            SubtotalSum3 = fn.Round(SubtotalSum2 + DataList(d), 2)
            If SubtotalSum1 > TargetValue Then GoTo Exit4_2
            If SubtotalSum2 > TargetValue Then GoTo Exit4_1
            If SubtotalSum3 > TargetValue Then
                GoTo Exit4
            ElseIf SubtotalSum3 = TargetValue Then
            Counter = Counter + 1
            SolutionArray(Counter) = DataList(a) & " | " & DataList(b) _
            & " | " & DataList(c) & " | " & DataList(d)
            End If
        Next d
Exit4:
        Next c
Exit4_1:
        Next b
Exit4_2:
        Next a

    Case 5
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements + 2 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b), HoldingArray(2), 0)) Then GoTo Exit5_3
            
        For c = b + 1 To elements + 3 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c), HoldingArray(3), 0)) Then GoTo Exit5_2
        
        For d = c + 1 To elements + 4 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d), _
            HoldingArray(4), 0)) Then GoTo Exit5_1
              
        For e = d + 1 To elements
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            SubtotalSum2 = fn.Round(SubtotalSum1 + DataList(c), 2)
            SubtotalSum3 = fn.Round(SubtotalSum2 + DataList(d), 2)
            SubtotalSum4 = fn.Round(SubtotalSum3 + DataList(e), 2)
            If SubtotalSum1 > TargetValue Then GoTo Exit5_3
            If SubtotalSum2 > TargetValue Then GoTo Exit5_2
            If SubtotalSum3 > TargetValue Then GoTo Exit5_1
            If SubtotalSum4 > TargetValue Then
                GoTo Exit5
            ElseIf SubtotalSum4 = TargetValue Then
            Counter = Counter + 1
            SolutionArray(Counter) = DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) & " | " & DataList(e)
            End If
        Next e
Exit5:
        Next d
Exit5_1:
        Next c
Exit5_2:
        Next b
Exit5_3:
        Next a

    Case 6
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements + 2 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b), HoldingArray(2), 0)) Then GoTo Exit6_4
        
        For c = b + 1 To elements + 3 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c), HoldingArray(3), 0)) Then GoTo Exit6_3
        
        For d = c + 1 To elements + 4 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d), _
            HoldingArray(4), 0)) Then GoTo Exit6_2
            
        For e = d + 1 To elements + 5 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) _
            & " | " & DataList(e), HoldingArray(5), 0)) Then GoTo Exit6_1
        
        For f = e + 1 To elements
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            SubtotalSum2 = fn.Round(SubtotalSum1 + DataList(c), 2)
            SubtotalSum3 = fn.Round(SubtotalSum2 + DataList(d), 2)
            SubtotalSum4 = fn.Round(SubtotalSum3 + DataList(e), 2)
            SubtotalSum5 = fn.Round(SubtotalSum4 + DataList(f), 2)
            
            If SubtotalSum1 > TargetValue Then GoTo Exit6_4
            If SubtotalSum2 > TargetValue Then GoTo Exit6_3
            If SubtotalSum3 > TargetValue Then GoTo Exit6_2
            If SubtotalSum4 > TargetValue Then GoTo Exit6_1
            If SubtotalSum5 > TargetValue Then
                GoTo Exit6
            ElseIf SubtotalSum5 = TargetValue Then
            Counter = Counter + 1
            SolutionArray(Counter) = DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) & " | " & DataList(e) & " | " & DataList(f)
            End If
        Next f
Exit6:
        Next e
Exit6_1:
        Next d
Exit6_2:
        Next c
Exit6_3:
        Next b
Exit6_4:
        Next a


    Case 7
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements + 2 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b), HoldingArray(2), 0)) Then GoTo Exit7_5
        
        For c = b + 1 To elements + 3 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c), HoldingArray(3), 0)) Then GoTo Exit7_4
        
        For d = c + 1 To elements + 4 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d), _
            HoldingArray(4), 0)) Then GoTo Exit7_3
            
        For e = d + 1 To elements + 5 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) _
            & " | " & DataList(e), HoldingArray(5), 0)) Then GoTo Exit7_2
        
        For f = e + 1 To elements + 6 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) _
            & " | " & DataList(e) & " | " & DataList(f), HoldingArray(6), 0)) Then GoTo Exit7_1
            
        For g = f + 1 To elements
        Application.StatusBar = a & "|" & b & "|" & c & "|" & d & "|" & e & "|" & f
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            SubtotalSum2 = fn.Round(SubtotalSum1 + DataList(c), 2)
            SubtotalSum3 = fn.Round(SubtotalSum2 + DataList(d), 2)
            SubtotalSum4 = fn.Round(SubtotalSum3 + DataList(e), 2)
            SubtotalSum5 = fn.Round(SubtotalSum4 + DataList(f), 2)
            SubtotalSum6 = fn.Round(SubtotalSum5 + DataList(g), 2)
            If SubtotalSum1 > TargetValue Then GoTo Exit7_5
            If SubtotalSum2 > TargetValue Then GoTo Exit7_4
            If SubtotalSum3 > TargetValue Then GoTo Exit7_3
            If SubtotalSum4 > TargetValue Then GoTo Exit7_2
            If SubtotalSum5 > TargetValue Then GoTo Exit7_1
            If SubtotalSum6 > TargetValue Then
                GoTo Exit7
            ElseIf SubtotalSum6 = TargetValue Then
            Counter = Counter + 1
            If Counter = 1 Then
                ReDim SolutionArray(1 To Counter) As String
            Else
                ReDim Preserve SolutionArray(1 To Counter) As String
            End If
            SolutionArray(Counter) = DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) & " | " & DataList(e) _
            & " | " & DataList(f) & " | " & DataList(g)
            End If
        Next g
Exit7:
        Next f
Exit7_1:
        Next e
Exit7_2:
        Next d
Exit7_3:
        Next c
Exit7_4:
        Next b
Exit7_5:
        Next a

    Case 8
        For a = 1 To elements + 1 - numselect
        For b = a + 1 To elements + 2 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b), HoldingArray(2), 0)) Then GoTo Exit8_6
        
        For c = b + 1 To elements + 3 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c), HoldingArray(3), 0)) Then GoTo Exit8_5
        
        For d = c + 1 To elements + 4 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d), _
            HoldingArray(4), 0)) Then GoTo Exit8_4
            
        For e = d + 1 To elements + 5 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) _
            & " | " & DataList(e), HoldingArray(5), 0)) Then GoTo Exit8_3
        
        For f = e + 1 To elements + 6 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) _
            & " | " & DataList(e) & " | " & DataList(f), HoldingArray(6), 0)) Then GoTo Exit8_2
            
        For g = f + 1 To elements + 7 - numselect
            If Not IsError(Application.Match(DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) _
            & " | " & DataList(e) & " | " & DataList(f) & " | " & DataList(g), HoldingArray(7), 0)) Then GoTo Exit8_1
        
        For h = g + 1 To elements
        Application.StatusBar = a & "|" & b & "|" & c & "|" & d & "|" & e & "|" & f
            SubtotalSum1 = fn.Round(DataList(a) + DataList(b), 2)
            SubtotalSum2 = fn.Round(SubtotalSum1 + DataList(c), 2)
            SubtotalSum3 = fn.Round(SubtotalSum2 + DataList(d), 2)
            SubtotalSum4 = fn.Round(SubtotalSum3 + DataList(e), 2)
            SubtotalSum5 = fn.Round(SubtotalSum4 + DataList(f), 2)
            SubtotalSum6 = fn.Round(SubtotalSum5 + DataList(g), 2)
            SubtotalSum7 = fn.Round(SubtotalSum6 + DataList(h), 2)
            If SubtotalSum1 > TargetValue Then GoTo Exit8_6
            If SubtotalSum2 > TargetValue Then GoTo Exit8_5
            If SubtotalSum3 > TargetValue Then GoTo Exit8_4
            If SubtotalSum4 > TargetValue Then GoTo Exit8_3
            If SubtotalSum5 > TargetValue Then GoTo Exit8_2
            If SubtotalSum6 > TargetValue Then GoTo Exit8_1
            If SubtotalSum7 > TargetValue Then
                GoTo Exit8
            ElseIf SubtotalSum7 = TargetValue Then
            Counter = Counter + 1
            If Counter = 1 Then
                ReDim SolutionArray(1 To Counter) As String
            Else
                ReDim Preserve SolutionArray(1 To Counter) As String
            End If
            SolutionArray(Counter) = DataList(a) & " | " & DataList(b) & " | " & DataList(c) & " | " & DataList(d) & " | " & DataList(e) _
            & " | " & DataList(f) & " | " & DataList(g) & " | " & DataList(h)
            End If
        Next h
Exit8:
        Next g
Exit8_1:
        Next f
Exit8_2:
        Next e
Exit8_3:
        Next d
Exit8_4:
        Next c
Exit8_5:
        Next b
Exit8_6:
        Next a

----snip lots of similar code---

End Select
    If Counter = 0 Then
        ReDim SolutionArray(1 To 1)
        SolutionArray(1) = "No solutions"
    Else
        ReDim Preserve SolutionArray(1 To Counter) As String
    End If
Find_Possible = SolutionArray
Erase SolutionArray
End Function

_________________
Bye,
Jay
This message was edited by Jay Petrulis on 2002-08-31 07:26

 

[IOANNIS]

HI ALL !!
I am back (i was on holidays ..)

Finallly after a few changes my macros speed is about 41000/hour (in pentium III800, 512ram, excel 2000)

18 hours and 20 minutes !!

i email it to Mrexcel

I run the macro to another pentium III 800, 256ram, excel 2000, and the speed was after 0:02:25 min 87.244 !!!

somethins has my computer at home ..

..screen shot ..

BRUTE_FORCE_FINAL.xls
	A	B	C	D	E	F	G	H
1	1	77,740	RES_01		TOTALINVOCIES	54		12345678910111213141518203436
2	2	83,060	RES_02		CHECK	4556,92		12345678910111213141619232838
3	3	89,400	RES_03		MAX_SUM_NUMBERS	21		12345678910111213151617182445
4	4	116,140	RES_04		MAX_CHECK_No	53		123456789101112131617283340
5	5	126,690	RES_05		CURRENTSHEET_SOLUTIONS	3514		123456789101112131622262744
6	6	144,770	RES_06		TOTAL_SOLUTIONS_FOUND	3514		1234567891011121317283649
7	7	160,620	RES_07		TOTALSHEETSOLUTIONS	0		1234567891011121325313641
8	8	185,580	RES_08		MAX_RESUME_No	0		123456789101112141522242746
9	9	192,650	RES_09		LASTSOLUTIONFOUNDorCOMBINATION			123456789101112141617213346
10	10	194,580	RES_10		53			1234567891011121420284144
11	11	219,100	RES_11		CHECKEDCOMBINATIONS	=Print_No(E10;F4)		12345678910111215162022242728
12	12	222,520	RES_12		TOTAL_COMBINATIONS	9.007.199.254.740.990		12345678910111215171920212436
13	13	228,310	RES_13		COMBINATION'S%DONE	=(F11/F12)*100		1234567891011121718343738
14	14	230,720	RES_14		MACRO'STIMESTART	20:07:27		1234567891011121721233249
15	15	244,220	RES_15		LASTFOUNDSOLUTION'STIME	20:09:52		1234567891011122426273042
16	16	280,710	RES_16		ELAPSEDTIME	0:02:25		123456789101113141618193148
17	17	324,840	RES_17		REMAINTIME	=F19*((100-F13)/F13)		123456789101113141823283035
18	18	329,170	RES_18		LASTRESUMETIME	0:00:00		1234567891011131424263348
19	19	329,970	RES_19		TOTALCALCTIME	0:02:25		1234567891011131516373842
20	20	346,350	RES_20		SOLUTION'SSPEED/HOUR	87.244		1234567891011131518264246
21	21	365,430	RES_21					1234567891011131824313537
22	22	409,170	RES_22					1234567891011132021293243
23	23	440,930	RES_23					1234567891011141517194647
24	24	441,430	RES_24					12345678910111415172021222631
25	25	444,980	RES_25					123456789101114151821252645
26	26	456,680	RES_26					1234567891011141617293546
August 2002 Challenge

I must check it ...

Bye for now ...

 

[Jay Petrulis]

Hi Ioannis,

Nice job. When the published results are available, I am confident that you and Sharad K. will take the top spots. My routine won't get anywhere near your speed for sure.

The Solver routines, if they can store prior solutions and elminate them from the next iteration, may be even faster, although there may be a chance that they won't exhaust all possibilities.

Kudos.

 

[IOANNIS]

Hi Jay

I checked my computer's speed and now is ok

I re run the macro and the final speed for
my computer is now 62300 solutions per hour
and 11 hours and 59 minutes !!

My macro olso support and negative numbers

I have check it with extreme sets off numbers,
such as o.oo numbers, all zeros, check=0, gives all compinations)

Zeros with negative and positive numbers and
if all numbers are equal (01=1, 02=1, 03=1, 04=1 ...) and all the tests was ok ..

Since I want to make a general brute force macro, the macro do not use any Excel's features and is easy to tranfered to another programming language sush as c++ for optimum speed

The Sharad Kothari macro is Excellent !
Good work Sharad

 

[IOANNIS]

... I will run the the Sharad Kothari macro on my computer to compare the speed ...

.. I will post the results when i am ready ..

 

[IOANNIS]

..after 9:20 minutes the Sharad Kothari macro has found 531553 solutions with speed 57000 per hour ..

.. With this speed the macro will finished after 4 hours with total execution time about 13 hours and 8 to 12 minutes ..

 

[IOANNIS]

..fINAL speed 55000/hour, 13 hours ang 37 minites..

 

[IOANNIS]

to MrExcel

I cant email the solutions xls ...

..

Your message did not reach some or all of the intended recipients.

Subject: August Challenge Macro
Sent: 31/8/2002 7:56 ìì

The following recipient(s) could not be reached:

mrexcel@ameritech.net on 31/8/2002 9:32 ìì
This message is larger than the current system limit or the recipient's mailbox is full. Create a shorter message body or remove attachments and try sending it again.
< net3.planetnet.com #5.2.2>

...

I email only the macro xls ...

...