Hi,
I am trying to use the Solver add-in and am having trouble with it
My spreadsheet is as follows:
InvNum InvAmt Flag AmtDue
1 100 1 =B2*C2
2 150 1 =B3*C3
<snip rows
50 Total 0 =SUM(D2:D49)

I've set solver up as follows:
Set Target Cell = $D$50
Equal to Value of 844.65
Subject to constraints:
$C$2:$C$49 <= 1
$C$2:$C$49 = integer
$C$2:$C$49 = 0

I want Solver to find that combination of invoices that would give me a
total of the target value.
The logic is that the flag would either be 0 or 1.

However, Solver does not recognize the second constraint: $C$2:$C$49 =
integer, and iterates all possible values between 0 and 1.
What am I doing wrong?

I recall doing this before, and I can't see where I am wrong.

Thanks in advance for any assistance.

Regards
Habib



--
Habib Salim
www.DynExtra.com
A resource for the Microsoft Dynamics Community
Featuring FAQs, File Exchange and more
Current member count: 10

Here is some code from Harlan Grove. It will find all of the combinations of
numbers that add up to a specified sum...

Sub findsums()
'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0 or higher


Const TOL As Double = 0.000001 'modify as needed
Dim c As Variant


Dim j As Long, k As Long, n As Long, p As Boolean
Dim s As String, t As Double, u As Double
Dim v As Variant, x As Variant, y As Variant
Dim dc1 As New Dictionary, dc2 As New Dictionary
Dim dcn As Dictionary, dco As Dictionary
Dim re As New RegExp


re.Global = True
re.IgnoreCase = True


On Error Resume Next


Set x = Application.InputBox( _
Prompt:="Enter range of values:", _
Title:="findsums", _
Default:="", _
Type:=8 _
)


If x Is Nothing Then
Err.Clear
Exit Sub
End If


y = Application.InputBox( _
Prompt:="Enter target value:", _
Title:="findsums", _
Default:="", _
Type:=1 _
)


If VarType(y) = vbBoolean Then
Exit Sub
Else
t = y
End If


On Error GoTo 0


Set dco = dc1
Set dcn = dc2


Call recsoln


For Each y In x.Value2
If VarType(y) = vbDouble Then
If Abs(t - y) < TOL Then
recsoln "+" & Format(y)


ElseIf dco.Exists(y) Then
dco(y) = dco(y) + 1


ElseIf y < t - TOL Then
dco.Add Key:=y, Item:=1


c = CDec(c + 1)
Application.StatusBar = "[1] " & Format(c)


End If


End If
Next y


n = dco.Count


ReDim v(1 To n, 1 To 3)


For k = 1 To n
v(k, 1) = dco.Keys(k - 1)
v(k, 2) = dco.Items(k - 1)
Next k


qsortd v, 1, n


For k = n To 1 Step -1
v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3)
If v(k, 3) t Then dcn.Add Key:="+" & _
Format(v(k, 1)), Item:=v(k, 1)
Next k


On Error GoTo CleanUp
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


For k = 2 To n
dco.RemoveAll
swapo dco, dcn


For Each y In dco.Keys
p = False


For j = 1 To n
If v(j, 3) < t - dco(y) - TOL Then Exit For
x = v(j, 1)
s = "+" & Format(x)
If Right(y, Len(s)) = s Then p = True
If p Then
re.Pattern = "\" & s & "(?=(\+|$))"
If re.Execute(y).Count < v(j, 2) Then
u = dco(y) + x
If Abs(t - u) < TOL Then
recsoln y & s
ElseIf u < t - TOL Then
dcn.Add Key:=y & s, Item:=u
c = CDec(c + 1)
Application.StatusBar = "[" & Format(k) & "] " & _
Format(c)
End If
End If
End If
Next j
Next y


If dcn.Count = 0 Then Exit For
Next k


If (recsoln() = 0) Then _
MsgBox Prompt:="all combinations exhausted", _
Title:="No Solution"


CleanUp:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False


End Sub


Private Function recsoln(Optional s As String)
Const OUTPUTWSN As String = "findsums solutions" 'modify to taste


Static r As Range
Dim ws As Worksheet


If s = "" And r Is Nothing Then
On Error Resume Next
Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN)
If ws Is Nothing Then
Err.Clear
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set r = Worksheets.Add.Range("A1")
r.Parent.Name = OUTPUTWSN
ws.Activate
Application.ScreenUpdating = False
Else
ws.Cells.Clear
Set r = ws.Range("A1")
End If
recsoln = 0
ElseIf s = "" Then
recsoln = r.Row - 1
Set r = Nothing
Else
r.Value = s
Set r = r.Offset(1, 0)
recsoln = r.Row - 1
End If
End Function


Private Sub qsortd(v As Variant, lft As Long, rgt As Long)
'ad hoc quicksort subroutine
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim j As Long, pvt As Long


If (lft = rgt) Then Exit Sub
swap2 v, lft, lft + Int((rgt - lft + 1) * Rnd)
pvt = lft
For j = lft + 1 To rgt
If v(j, 1) v(lft, 1) Then
pvt = pvt + 1
swap2 v, pvt, j
End If
Next j


swap2 v, lft, pvt


qsortd v, lft, pvt - 1
qsortd v, pvt + 1, rgt
End Sub


Private Sub swap2(v As Variant, i As Long, j As Long)
'modified version of the swap procedure from
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim t As Variant, k As Long


For k = LBound(v, 2) To UBound(v, 2)
t = v(i, k)
v(i, k) = v(j, k)
v(j, k) = t
Next k
End Sub


Private Sub swapo(a As Object, b As Object)
Dim t As Object


Set t = a
Set a = b
Set b = t
End Sub
'---- end VBA code ----


--
HTH...

Jim Thomlinson


"HSalim[MVP]" wrote:

Hi,
I am trying to use the Solver add-in and am having trouble with it
My spreadsheet is as follows:
InvNum InvAmt Flag AmtDue
1 100 1 =B2*C2
2 150 1 =B3*C3
<snip rows
50 Total 0 =SUM(D2:D49)

I've set solver up as follows:
Set Target Cell = $D$50
Equal to Value of 844.65
Subject to constraints:
$C$2:$C$49 <= 1
$C$2:$C$49 = integer
$C$2:$C$49 = 0

I want Solver to find that combination of invoices that would give me a
total of the target value.
The logic is that the flag would either be 0 or 1.

However, Solver does not recognize the second constraint: $C$2:$C$49 =
integer, and iterates all possible values between 0 and 1.
What am I doing wrong?

I recall doing this before, and I can't see where I am wrong.

Thanks in advance for any assistance.

Regards
Habib



--
Habib Salim
www.DynExtra.com
A resource for the Microsoft Dynamics Community
Featuring FAQs, File Exchange and more
Current member count: 10

Jim,
Thanks for the code. I'll post my comments once I have used it.. it looks
like a great tool.
Who is Harlan Grove? Thanks to him as well
If it works as i think it will, I'll add it as a FAQ at DynExtra.
Regards
Habib

--
Habib Salim
www.DynExtra.com
A resource for the Microsoft Dynamics Community
Featuring FAQs, File Exchange and more
Current member count: 3
"Jim Thomlinson" wrote in message
...
Here is some code from Harlan Grove. It will find all of the combinations
of
numbers that add up to a specified sum...

Sub findsums()
'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0 or higher


Const TOL As Double = 0.000001 'modify as needed
Dim c As Variant


Dim j As Long, k As Long, n As Long, p As Boolean
Dim s As String, t As Double, u As Double
Dim v As Variant, x As Variant, y As Variant
Dim dc1 As New Dictionary, dc2 As New Dictionary
Dim dcn As Dictionary, dco As Dictionary
Dim re As New RegExp


re.Global = True
re.IgnoreCase = True


On Error Resume Next


Set x = Application.InputBox( _
Prompt:="Enter range of values:", _
Title:="findsums", _
Default:="", _
Type:=8 _
)


If x Is Nothing Then
Err.Clear
Exit Sub
End If


y = Application.InputBox( _
Prompt:="Enter target value:", _
Title:="findsums", _
Default:="", _
Type:=1 _
)


If VarType(y) = vbBoolean Then
Exit Sub
Else
t = y
End If


On Error GoTo 0


Set dco = dc1
Set dcn = dc2


Call recsoln


For Each y In x.Value2
If VarType(y) = vbDouble Then
If Abs(t - y) < TOL Then
recsoln "+" & Format(y)


ElseIf dco.Exists(y) Then
dco(y) = dco(y) + 1


ElseIf y < t - TOL Then
dco.Add Key:=y, Item:=1


c = CDec(c + 1)
Application.StatusBar = "[1] " & Format(c)


End If


End If
Next y


n = dco.Count


ReDim v(1 To n, 1 To 3)


For k = 1 To n
v(k, 1) = dco.Keys(k - 1)
v(k, 2) = dco.Items(k - 1)
Next k


qsortd v, 1, n


For k = n To 1 Step -1
v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3)
If v(k, 3) t Then dcn.Add Key:="+" & _
Format(v(k, 1)), Item:=v(k, 1)
Next k


On Error GoTo CleanUp
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


For k = 2 To n
dco.RemoveAll
swapo dco, dcn


For Each y In dco.Keys
p = False


For j = 1 To n
If v(j, 3) < t - dco(y) - TOL Then Exit For
x = v(j, 1)
s = "+" & Format(x)
If Right(y, Len(s)) = s Then p = True
If p Then
re.Pattern = "\" & s & "(?=(\+|$))"
If re.Execute(y).Count < v(j, 2) Then
u = dco(y) + x
If Abs(t - u) < TOL Then
recsoln y & s
ElseIf u < t - TOL Then
dcn.Add Key:=y & s, Item:=u
c = CDec(c + 1)
Application.StatusBar = "[" & Format(k) & "] " & _
Format(c)
End If
End If
End If
Next j
Next y


If dcn.Count = 0 Then Exit For
Next k


If (recsoln() = 0) Then _
MsgBox Prompt:="all combinations exhausted", _
Title:="No Solution"


CleanUp:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False


End Sub


Private Function recsoln(Optional s As String)
Const OUTPUTWSN As String = "findsums solutions" 'modify to taste


Static r As Range
Dim ws As Worksheet


If s = "" And r Is Nothing Then
On Error Resume Next
Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN)
If ws Is Nothing Then
Err.Clear
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set r = Worksheets.Add.Range("A1")
r.Parent.Name = OUTPUTWSN
ws.Activate
Application.ScreenUpdating = False
Else
ws.Cells.Clear
Set r = ws.Range("A1")
End If
recsoln = 0
ElseIf s = "" Then
recsoln = r.Row - 1
Set r = Nothing
Else
r.Value = s
Set r = r.Offset(1, 0)
recsoln = r.Row - 1
End If
End Function


Private Sub qsortd(v As Variant, lft As Long, rgt As Long)
'ad hoc quicksort subroutine
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim j As Long, pvt As Long


If (lft = rgt) Then Exit Sub
swap2 v, lft, lft + Int((rgt - lft + 1) * Rnd)
pvt = lft
For j = lft + 1 To rgt
If v(j, 1) v(lft, 1) Then
pvt = pvt + 1
swap2 v, pvt, j
End If
Next j


swap2 v, lft, pvt


qsortd v, lft, pvt - 1
qsortd v, pvt + 1, rgt
End Sub


Private Sub swap2(v As Variant, i As Long, j As Long)
'modified version of the swap procedure from
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim t As Variant, k As Long


For k = LBound(v, 2) To UBound(v, 2)
t = v(i, k)
v(i, k) = v(j, k)
v(j, k) = t
Next k
End Sub


Private Sub swapo(a As Object, b As Object)
Dim t As Object


Set t = a
Set a = b
Set b = t
End Sub
'---- end VBA code ----


--
HTH...

Jim Thomlinson


"HSalim[MVP]" wrote:

Hi,
I am trying to use the Solver add-in and am having trouble with it
My spreadsheet is as follows:
InvNum InvAmt Flag AmtDue
1 100 1 =B2*C2
2 150 1 =B3*C3
<snip rows
50 Total 0 =SUM(D2:D49)

I've set solver up as follows:
Set Target Cell = $D$50
Equal to Value of 844.65
Subject to constraints:
$C$2:$C$49 <= 1
$C$2:$C$49 = integer
$C$2:$C$49 = 0

I want Solver to find that combination of invoices that would give me a
total of the target value.
The logic is that the flag would either be 0 or 1.

However, Solver does not recognize the second constraint: $C$2:$C$49 =
integer, and iterates all possible values between 0 and 1.
What am I doing wrong?

I recall doing this before, and I can't see where I am wrong.

Thanks in advance for any assistance.

Regards
Habib



--
Habib Salim
www.DynExtra.com
A resource for the Microsoft Dynamics Community
Featuring FAQs, File Exchange and more
Current member count: 10

$C$2:$C$49 <= 1
$C$2:$C$49 = integer
$C$2:$C$49 = 0
I recall doing this before, and I can't see where I am wrong.

Just a side note: What you want to do is set the constraint to "bin",
meaning "Binary".
This is an integer 0 or 1, and replaces the three lines above.

$C$2:$C$49 = Binary

(Harlan's code is excellent!)
--
HTH. :)
Dana DeLouis
Windows XP, Office 2003


"HSalim[MVP]" wrote in message
...
Jim,
Thanks for the code. I'll post my comments once I have used it.. it
looks like a great tool.
Who is Harlan Grove? Thanks to him as well
If it works as i think it will, I'll add it as a FAQ at DynExtra.
Regards
Habib

--
Habib Salim
www.DynExtra.com
A resource for the Microsoft Dynamics Community
Featuring FAQs, File Exchange and more
Current member count: 3
"Jim Thomlinson" wrote in
message ...
Here is some code from Harlan Grove. It will find all of the combinations
of
numbers that add up to a specified sum...

Sub findsums()
'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0 or higher


Const TOL As Double = 0.000001 'modify as needed
Dim c As Variant


Dim j As Long, k As Long, n As Long, p As Boolean
Dim s As String, t As Double, u As Double
Dim v As Variant, x As Variant, y As Variant
Dim dc1 As New Dictionary, dc2 As New Dictionary
Dim dcn As Dictionary, dco As Dictionary
Dim re As New RegExp


re.Global = True
re.IgnoreCase = True


On Error Resume Next


Set x = Application.InputBox( _
Prompt:="Enter range of values:", _
Title:="findsums", _
Default:="", _
Type:=8 _
)


If x Is Nothing Then
Err.Clear
Exit Sub
End If


y = Application.InputBox( _
Prompt:="Enter target value:", _
Title:="findsums", _
Default:="", _
Type:=1 _
)


If VarType(y) = vbBoolean Then
Exit Sub
Else
t = y
End If


On Error GoTo 0


Set dco = dc1
Set dcn = dc2


Call recsoln


For Each y In x.Value2
If VarType(y) = vbDouble Then
If Abs(t - y) < TOL Then
recsoln "+" & Format(y)


ElseIf dco.Exists(y) Then
dco(y) = dco(y) + 1


ElseIf y < t - TOL Then
dco.Add Key:=y, Item:=1


c = CDec(c + 1)
Application.StatusBar = "[1] " & Format(c)


End If


End If
Next y


n = dco.Count


ReDim v(1 To n, 1 To 3)


For k = 1 To n
v(k, 1) = dco.Keys(k - 1)
v(k, 2) = dco.Items(k - 1)
Next k


qsortd v, 1, n


For k = n To 1 Step -1
v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3)
If v(k, 3) t Then dcn.Add Key:="+" & _
Format(v(k, 1)), Item:=v(k, 1)
Next k


On Error GoTo CleanUp
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


For k = 2 To n
dco.RemoveAll
swapo dco, dcn


For Each y In dco.Keys
p = False


For j = 1 To n
If v(j, 3) < t - dco(y) - TOL Then Exit For
x = v(j, 1)
s = "+" & Format(x)
If Right(y, Len(s)) = s Then p = True
If p Then
re.Pattern = "\" & s & "(?=(\+|$))"
If re.Execute(y).Count < v(j, 2) Then
u = dco(y) + x
If Abs(t - u) < TOL Then
recsoln y & s
ElseIf u < t - TOL Then
dcn.Add Key:=y & s, Item:=u
c = CDec(c + 1)
Application.StatusBar = "[" & Format(k) & "] " & _
Format(c)
End If
End If
End If
Next j
Next y


If dcn.Count = 0 Then Exit For
Next k


If (recsoln() = 0) Then _
MsgBox Prompt:="all combinations exhausted", _
Title:="No Solution"


CleanUp:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False


End Sub


Private Function recsoln(Optional s As String)
Const OUTPUTWSN As String = "findsums solutions" 'modify to taste


Static r As Range
Dim ws As Worksheet


If s = "" And r Is Nothing Then
On Error Resume Next
Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN)
If ws Is Nothing Then
Err.Clear
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set r = Worksheets.Add.Range("A1")
r.Parent.Name = OUTPUTWSN
ws.Activate
Application.ScreenUpdating = False
Else
ws.Cells.Clear
Set r = ws.Range("A1")
End If
recsoln = 0
ElseIf s = "" Then
recsoln = r.Row - 1
Set r = Nothing
Else
r.Value = s
Set r = r.Offset(1, 0)
recsoln = r.Row - 1
End If
End Function


Private Sub qsortd(v As Variant, lft As Long, rgt As Long)
'ad hoc quicksort subroutine
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim j As Long, pvt As Long


If (lft = rgt) Then Exit Sub
swap2 v, lft, lft + Int((rgt - lft + 1) * Rnd)
pvt = lft
For j = lft + 1 To rgt
If v(j, 1) v(lft, 1) Then
pvt = pvt + 1
swap2 v, pvt, j
End If
Next j


swap2 v, lft, pvt


qsortd v, lft, pvt - 1
qsortd v, pvt + 1, rgt
End Sub


Private Sub swap2(v As Variant, i As Long, j As Long)
'modified version of the swap procedure from
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim t As Variant, k As Long


For k = LBound(v, 2) To UBound(v, 2)
t = v(i, k)
v(i, k) = v(j, k)
v(j, k) = t
Next k
End Sub


Private Sub swapo(a As Object, b As Object)
Dim t As Object


Set t = a
Set a = b
Set b = t
End Sub
'---- end VBA code ----


--
HTH...

Jim Thomlinson


"HSalim[MVP]" wrote:

Hi,
I am trying to use the Solver add-in and am having trouble with it
My spreadsheet is as follows:
InvNum InvAmt Flag AmtDue
1 100 1 =B2*C2
2 150 1 =B3*C3
<snip rows
50 Total 0 =SUM(D2:D49)

I've set solver up as follows:
Set Target Cell = $D$50
Equal to Value of 844.65
Subject to constraints:
$C$2:$C$49 <= 1
$C$2:$C$49 = integer
$C$2:$C$49 = 0

I want Solver to find that combination of invoices that would give me a
total of the target value.
The logic is that the flag would either be 0 or 1.

However, Solver does not recognize the second constraint: $C$2:$C$49 =
integer, and iterates all possible values between 0 and 1.
What am I doing wrong?

I recall doing this before, and I can't see where I am wrong.

Thanks in advance for any assistance.

Regards
Habib



--
Habib Salim
www.DynExtra.com
A resource for the Microsoft Dynamics Community
Featuring FAQs, File Exchange and more
Current member count: 10

Hi all,

Can someone help me with the syntax to* programmatically *set SOLVER
reference. I have been looking for this for some time now.

David.


--
davidm
------------------------------------------------------------------------
davidm's Profile: http://www.excelforum.com/member.php...o&userid=20645
View this thread: http://www.excelforum.com/showthread...hreadid=533637