ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   optimum - questions for experts (https://www.excelbanter.com/excel-programming/279217-optimum-questions-experts.html)

Mark[_17_]

optimum - questions for experts
 
Hi,

I looking for smart solve (in VBA) the following
hypothetical example:

How count optimum R?

W = POINTS[(2NAME)*INDEX(BEETWEEN 100 AND 120)]
K = POINTS[(3NAME*INDEX(BEETWEEN 110 AND 170)]

R = W + K

Necessary conditium: Counted Points must have total INDEX
550


NAME INDEX POINTS
AAA 100 35
AAA 140 31
AAA 120 30
AAA 120 35
AAA 100 32
AAA 120 31
AAA 100 34
AAA 140 30
BBB 105 31
BBB 122 33
BBB 105 33
BBB 122 38
BBB 105 29
BBB 142 32
etc....


Please advise I would be very grateful.
Best regards
Mark


keepITcool

optimum - questions for experts
 
The Solver Addin can help you here...

Make sure the solver addin is loaded

The in the VBE add a REFERENCE to solver.xla

Then try following code.. I've asuumed that you want minimum points,
while index =550.

The column D on sheet2 will give you your optimum combination.


Sub Optimize()
Dim src As Range, crit As Range, dest As Range
Dim rPP As Range, rPI As Range, rCH As Range

'Filter out the valid rows
With Worksheets(1)
Set src = .Range(.[c1], .[a65536].End(xlUp))
End With

Set crit = Worksheets(2).[a1:c1]
crit.Parent.Cells.Clear
crit.Offset(0) = src.Rows(1).Value
crit.Offset(1) = Array("AAA", "=100", "<=140")
crit.Offset(2) = Array("BBB", "=110", "<=170")


src.AdvancedFilter xlFilterCopy, crit.Resize(3), crit.Offset(5)
Set dest = crit.Offset(5).CurrentRegion
Set dest = dest.Offset(1).Resize(dest.Rows.Count - 1, 4)
dest.Columns(4) = 0

Set rPP = Cells(1, 4)
Set rPI = Cells(2, 4)
Set rCH = dest.Columns(4)

rPP.Formula = "=sumproduct(" & dest.Columns(2).Address & "," &
rCH.Address & ")"
rPI.Formula = "=sumproduct(" & dest.Columns(3).Address & "," &
rCH.Address & ")"

crit.Parent.Activate
'THIS NEEDS a VB REFERENCE to SOLVER.XLA

SolvReset
SolvOk rPI.Address, 2, 0, rCH.Address
SolvAdd rPP.Address, 3, "=550"
SolvAdd rCH.Address, 4, "integer"
SolvAdd rCH.Address, 1, "=1"
SolvOptions MaxTime:=10, AssumeLinear:=True, AssumeNonNeg:=True
SolvSolve UserFinish:=True
End Sub




keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Mark" wrote:

Hi,

I looking for smart solve (in VBA) the following
hypothetical example:

How count optimum R?

W = POINTS[(2NAME)*INDEX(BEETWEEN 100 AND 120)]
K = POINTS[(3NAME*INDEX(BEETWEEN 110 AND 170)]

R = W + K

Necessary conditium: Counted Points must have total INDEX
550


NAME INDEX POINTS
AAA 100 35
AAA 140 31
AAA 120 30
AAA 120 35
AAA 100 32
AAA 120 31
AAA 100 34
AAA 140 30
BBB 105 31
BBB 122 33
BBB 105 33
BBB 122 38
BBB 105 29
BBB 142 32
etc....


Please advise I would be very grateful.
Best regards
Mark



Bernie Deitrick[_2_]

optimum - questions for experts
 
Mark,

You haven't adequately described your problem or calculation
technique. Give an example using actual numbers.

HTH,
Bernie


"Mark" wrote in message
...
Hi,

I looking for smart solve (in VBA) the following
hypothetical example:

How count optimum R?

W = POINTS[(2NAME)*INDEX(BEETWEEN 100 AND 120)]
K = POINTS[(3NAME*INDEX(BEETWEEN 110 AND 170)]

R = W + K

Necessary conditium: Counted Points must have total INDEX
550


NAME INDEX POINTS
AAA 100 35
AAA 140 31
AAA 120 30
AAA 120 35
AAA 100 32
AAA 120 31
AAA 100 34
AAA 140 30
BBB 105 31
BBB 122 33
BBB 105 33
BBB 122 38
BBB 105 29
BBB 142 32
etc....


Please advise I would be very grateful.
Best regards
Mark




keepITcool

optimum - questions for experts
 
Mark,

oops.. you'll need to move 1 line a little upwards:

crit.Parent.Activate '<<should go to before the set rPP=

Set rPP = Cells(1, 4)
Set rPI = Cells(2, 4)
Set rCH = dest.Columns(4)

suc6

keepITcool


Mark[_17_]

optimum - questions for experts
 
more exact formula:

W = POINTS[(2NAME) with INDEX(BEETWEEN 100 AND 120)]
K = POINTS[(3NAME with INDEX(BEETWEEN 110 AND 170)]

R = W + K
Necessary conditium:
Counted Points must have total INDEX = 550

How count optimum R?
Kindly regards
Mark




-----Original Message-----
Hi,

I looking for smart solve (in VBA) the following
hypothetical example:

How count optimum R?

W = POINTS[(2NAME)*INDEX(BEETWEEN 100 AND 120)]
K = POINTS[(3NAME*INDEX(BEETWEEN 110 AND 170)]

R = W + K

Necessary conditium: Counted Points must have total INDEX
550


NAME INDEX POINTS
AAA 100 35
AAA 140 31
AAA 120 30
AAA 120 35
AAA 100 32
AAA 120 31
AAA 100 34
AAA 140 30
BBB 105 31
BBB 122 33
BBB 105 33
BBB 122 38
BBB 105 29
BBB 142 32
etc....


Please advise I would be very grateful.
Best regards
Mark

.


Mark[_17_]

optimum - questions for experts
 
Hi,
More detail, please - i don't know solver with VBA very
well.
besides...
Pop-up error 1004 in below line:
Set dest = dest.Offset(1).Resize(dest.Rows.Count - 1, 4)

How can I assign VBE REFERENCE to SOLVER.XLA?

Many thanks in anticipation!
Mark



-----Original Message-----
The Solver Addin can help you here...

Make sure the solver addin is loaded

The in the VBE add a REFERENCE to solver.xla

Then try following code.. I've asuumed that you want

minimum points,
while index =550.

The column D on sheet2 will give you your optimum

combination.


Sub Optimize()
Dim src As Range, crit As Range, dest As Range
Dim rPP As Range, rPI As Range, rCH As Range

'Filter out the valid rows
With Worksheets(1)
Set src = .Range(.[c1], .[a65536].End(xlUp))
End With

Set crit = Worksheets(2).[a1:c1]
crit.Parent.Cells.Clear
crit.Offset(0) = src.Rows(1).Value
crit.Offset(1) = Array("AAA", "=100", "<=140")
crit.Offset(2) = Array("BBB", "=110", "<=170")


src.AdvancedFilter xlFilterCopy, crit.Resize(3),

crit.Offset(5)
Set dest = crit.Offset(5).CurrentRegion
Set dest = dest.Offset(1).Resize(dest.Rows.Count - 1, 4)
dest.Columns(4) = 0

Set rPP = Cells(1, 4)
Set rPI = Cells(2, 4)
Set rCH = dest.Columns(4)

rPP.Formula = "=sumproduct(" & dest.Columns(2).Address

& "," &
rCH.Address & ")"
rPI.Formula = "=sumproduct(" & dest.Columns(3).Address

& "," &
rCH.Address & ")"

crit.Parent.Activate
'THIS NEEDS a VB REFERENCE to SOLVER.XLA

SolvReset
SolvOk rPI.Address, 2, 0, rCH.Address
SolvAdd rPP.Address, 3, "=550"
SolvAdd rCH.Address, 4, "integer"
SolvAdd rCH.Address, 1, "=1"
SolvOptions MaxTime:=10, AssumeLinear:=True,

AssumeNonNeg:=True
SolvSolve UserFinish:=True
End Sub




keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Mark" wrote:

Hi,

I looking for smart solve (in VBA) the following
hypothetical example:

How count optimum R?

W = POINTS[(2NAME)*INDEX(BEETWEEN 100 AND 120)]
K = POINTS[(3NAME*INDEX(BEETWEEN 110 AND 170)]

R = W + K

Necessary conditium: Counted Points must have total

INDEX
550


NAME INDEX POINTS
AAA 100 35
AAA 140 31
AAA 120 30
AAA 120 35
AAA 100 32
AAA 120 31
AAA 100 34
AAA 140 30
BBB 105 31
BBB 122 33
BBB 105 33
BBB 122 38
BBB 105 29
BBB 142 32
etc....


Please advise I would be very grateful.
Best regards
Mark


.


keepITcool

optimum - questions for experts
 
in EXCEL: tools/addins CHECK solver.
in VBE: tools/references, CHECK solver.xla

see my earlier OOPS re the runtime error
the line to activevate the dest sheet must come before the
assignment of the RPP/RPI variables.



keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Mark" wrote:

Hi,
More detail, please - i don't know solver with VBA very
well.
besides...
Pop-up error 1004 in below line:
Set dest = dest.Offset(1).Resize(dest.Rows.Count - 1, 4)

How can I assign VBE REFERENCE to SOLVER.XLA?

Many thanks in anticipation!
Mark




Mark[_17_]

optimum - questions for experts
 
Hi,
I do it finally! :) but..
Probably i inexactly describe my example. Sorry
Data in column Index is kilometers and Solver should count
only max points with fulfil total INDEX min 550(km).
In example are 2 kind of name (AAA, BBB) but really is
more name 200.

Solver is OK - that's news for me.
Is it do only in VBA also.

Sincere Thanks
Mark


-----Original Message-----
in EXCEL: tools/addins CHECK solver.
in VBE: tools/references, CHECK solver.xla

see my earlier OOPS re the runtime error
the line to activevate the dest sheet must come before the
assignment of the RPP/RPI variables.



keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"Mark" wrote:

Hi,
More detail, please - i don't know solver with VBA very
well.
besides...
Pop-up error 1004 in below line:
Set dest = dest.Offset(1).Resize(dest.Rows.Count - 1, 4)

How can I assign VBE REFERENCE to SOLVER.XLA?

Many thanks in anticipation!
Mark



.



All times are GMT +1. The time now is 10:06 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com