Solver UDF or Macro

[theta]

Hi. Looking for any good solver examples

I have my data in columns A:C. Column C contains the values. Need a macro to spit out all combination (all A:C ranges placed together) that add up to a given total

Ideas?

 

[theta]

Would be clearer with some sample data. I have seen one macro that does this (will upload later). But it does not copy the rows, only the values , and in broken order. I am trying to produce something clean that can be implemented into a month end reconciliation workbook :

HEADER 1 HEADER2  HEADER3
---------------------------------------
INVOICE 1 12/02/10  5.00
INVOICE 2 14/02/10 10.00
INVOICE 3 16/05/10 15.00
INVOICE 4 17/05/10  5.00
---------------------------------------
TARGET = 20

RESULT 1
========
INVOICE 1 12/02/10  5.00
INVOICE 3 16/05/10 15.00

RESULT 2
========
INVOICE 3 16/05/10 15.00
INVOICE 4 17/05/10  5.00

RESULT 3
========
INVOICE 1 12/02/10  5.00
INVOICE 2 14/02/10 10.00
INVOICE 4 17/05/10  5.00

 

[MrKowz]

Here is a solver macro that I came across a while ago. It has a very strict format, so be sure to read the comments in the startSearch() sub.

It will return in the adjacent column that you run it in

*Value you wanted it to find*, *Time it found the value*, *list of which values match as a relative row reference*

Here is what I came up with:

Excel 2003<TABLE style="BORDER-RIGHT: #a6aab6 1px solid; BORDER-TOP: #a6aab6 1px solid; BORDER-LEFT: #a6aab6 1px solid; BORDER-BOTTOM: #a6aab6 1px solid; BORDER-COLLAPSE: collapse; BACKGROUND-COLOR: #ffffff" cellPadding=2 rules=all><COLGROUP><COL style="BACKGROUND-COLOR: #e0e0f0" width=25><COL><COL><COL><COL><COL></COLGROUP><THEAD><TR style="COLOR: #161120; BACKGROUND-COLOR: #e0e0f0; TEXT-ALIGN: center"><TH></TH><TH>A</TH><TH>B</TH><TH>C</TH><TH>D</TH><TH>E</TH></TR></THEAD><TBODY><TR><TD style="COLOR: #161120; TEXT-ALIGN: center">1</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">0</TD><TD>20, 08:55:30, 1, 2, 4</TD><TD>1, 2, 4</TD></TR><TR><TD style="COLOR: #161120; TEXT-ALIGN: center">2</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right">20</TD><TD>20, 08:55:30, 1, 3</TD><TD>1, 3</TD></TR><TR><TD style="COLOR: #161120; TEXT-ALIGN: center">3</TD><TD>INVOICE 1</TD><TD style="TEXT-ALIGN: right">12/2/2010</TD><TD style="TEXT-ALIGN: right">$5.00</TD><TD>20, 08:55:30, 3, 4</TD><TD>3, 4</TD></TR><TR><TD style="COLOR: #161120; TEXT-ALIGN: center">4</TD><TD>INVOICE 2</TD><TD>14/02/10</TD><TD style="TEXT-ALIGN: right">$10.00</TD><TD style="TEXT-ALIGN: right">8:55:30</TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="COLOR: #161120; TEXT-ALIGN: center">5</TD><TD>INVOICE 3</TD><TD>16/05/10</TD><TD style="TEXT-ALIGN: right">$15.00</TD><TD style="TEXT-ALIGN: right">8:55:30</TD><TD style="TEXT-ALIGN: right"></TD></TR><TR><TD style="COLOR: #161120; TEXT-ALIGN: center">6</TD><TD>INVOICE 4</TD><TD>17/05/10</TD><TD style="TEXT-ALIGN: right">$5.00</TD><TD style="TEXT-ALIGN: right"></TD><TD style="TEXT-ALIGN: right"></TD></TR></TBODY></TABLE><TABLE style="BORDER-RIGHT: #a6aab6 1px solid; BORDER-TOP: #a6aab6 1px solid; BORDER-LEFT: #a6aab6 1px solid; BORDER-BOTTOM: #a6aab6 1px solid; BORDER-COLLAPSE: collapse; BACKGROUND-COLOR: #ffffff" cellPadding=2 rules=all><THEAD><TR style="COLOR: #161120; BACKGROUND-COLOR: #e0e0f0; TEXT-ALIGN: center"><TH>Sheet2</TH></TR></TD></THEAD><TBODY></TBODY></TABLE>

<TABLE style="BORDER-RIGHT: black 2px solid; PADDING-RIGHT: 0.4em; BORDER-TOP: black 2px solid; PADDING-LEFT: 0.4em; PADDING-BOTTOM: 0.4em; BORDER-LEFT: black 2px solid; PADDING-TOP: 0.4em; BORDER-BOTTOM: black 2px solid; BORDER-COLLAPSE: collapse; BACKGROUND-COLOR: #ffffff" cellPadding=2 rules=all width="85%"><TBODY><TR><TD style="PADDING-RIGHT: 6px; PADDING-LEFT: 6px; PADDING-BOTTOM: 6px; PADDING-TOP: 6px">Worksheet Formulas<TABLE style="BORDER-RIGHT: #a6aab6 1px solid; BORDER-TOP: #a6aab6 1px solid; BORDER-LEFT: #a6aab6 1px solid; BORDER-BOTTOM: #a6aab6 1px solid; BORDER-COLLAPSE: collapse; BACKGROUND-COLOR: #ffffff; TEXT-ALIGN: center" cellPadding=2 rules=all width="100%"><THEAD><TR style="COLOR: #161120; BACKGROUND-COLOR: #e0e0f0"><TH width=10>Cell</TH><TH style="PADDING-LEFT: 5px; TEXT-ALIGN: left">Formula</TH></TR></THEAD><TBODY><TR><TH style="COLOR: #161120; BACKGROUND-COLOR: #e0e0f0" width=10>E1</TH><TD style="TEXT-ALIGN: left">=RIGHT(D1,LEN(D1)-FIND(",",D1,FIND(",",D1)+1)-1)</TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE>


I included the MATCH formulas here so that you can see how to break off the numbers. Hopefully this gets you on the right track!

And the macro:

Option Explicit
Function RealEqual(A, B, Epsilon As Double)
    RealEqual = Abs(A - B) <= Epsilon
End Function
Function ExtendRslt(CurrRslt, NewVal, Separator)
    If CurrRslt = "" Then ExtendRslt = NewVal _
    Else ExtendRslt = CurrRslt & Separator & NewVal
End Function
Sub recursiveMatch(ByVal MaxSoln As Integer, ByVal TargetVal, InArr(), _
        ByVal CurrIdx As Integer, _
        ByVal CurrTotal, ByVal Epsilon As Double, _
        ByRef Rslt(), ByVal CurrRslt As String, ByVal Separator As String)
    Dim i As Integer
    For i = CurrIdx To UBound(InArr)
        If RealEqual(CurrTotal + InArr(i), TargetVal, Epsilon) Then
            Rslt(UBound(Rslt)) = (CurrTotal + InArr(i)) _
                & Separator & Format(Now(), "hh:mm:ss") _
                & Separator & ExtendRslt(CurrRslt, i, Separator)
            If MaxSoln = 0 Then
                If UBound(Rslt) Mod 100 = 0 Then Debug.Print UBound(Rslt) & "=" & Rslt(UBound(Rslt))
            Else
                If UBound(Rslt) >= MaxSoln Then Exit Sub
                End If
            ReDim Preserve Rslt(UBound(Rslt) + 1)
        ElseIf CurrTotal + InArr(i) > TargetVal + Epsilon Then
        ElseIf CurrIdx < UBound(InArr) Then
            recursiveMatch MaxSoln, TargetVal, InArr(), i + 1, _
                CurrTotal + InArr(i), Epsilon, Rslt(), _
                ExtendRslt(CurrRslt, i, Separator), _
                Separator
            If MaxSoln <> 0 Then If UBound(Rslt) >= MaxSoln Then Exit Sub
        Else
            'we've run out of possible elements and we _
             still don't have a match
        End If
   Next i
End Sub
Function ArrLen(Arr()) As Integer
    On Error Resume Next
    ArrLen = UBound(Arr) - LBound(Arr) + 1
End Function
Sub startSearch()
    'The selection should be a single contiguous range in a single column. _
     The first cell indicates the number of solutions wanted.  Specify zero for all. _
      The 2nd cell is the target value. _
      The rest of the cells are the values available for matching. _
      The output is in the column adjacent to the one containing the input data.
    Dim TargetVal, Rslt(), InArr(), StartTime As Date, MaxSoln As Integer
    StartTime = Now()
    MaxSoln = Selection.Cells(1).Value
    TargetVal = Selection.Cells(2).Value
    InArr = Application.WorksheetFunction.Transpose( _
        Selection.Offset(2, 0).Resize(Selection.Rows.Count - 2).Value)
    ReDim Rslt(0)
    recursiveMatch MaxSoln, TargetVal, InArr, LBound(InArr), 0, 0.00000001, _
        Rslt, "", ", "
    Rslt(UBound(Rslt)) = Format(Now, "hh:mm:ss")
    ReDim Preserve Rslt(UBound(Rslt) + 1)
    Rslt(UBound(Rslt)) = Format(StartTime, "hh:mm:ss")
    Selection.Offset(0, 1).Resize(ArrLen(Rslt), 1).Value = _
    Application.WorksheetFunction.Transpose(Rslt)
End Sub

 

[theta]

Hmmm just had a little play

Why does it stick 2 dates on the end (i.e. no match but still records a match time?)

Is this a bug as the two start cells (0, 20) are included in the selected range?

 

[MrKowz]

I honestly have no idea why it sticks two extra dates on the end.

And as for including 0 and 20 in the first 2 cells, that is the way it was programmed. The first cell in the selection is how many solutions you want (0 = all solutions), the second cell is your target number, and the rest of the cells are the data.

I didn't program this, and have had one heck of a time getting a basic understanding of the code. This is the best information I can give ya.

 

[theta]

Just out of interest, where did you get this code from?

Thanks

 

[MrKowz]

Took me a minute to track down the link:

http://www.tushar-mehta.com/excel/templates/match_values/index.html#VBA_multiple_combinations