G
Greg Snidow
Greetings all. I will tell you now, this is very long, and I am just looking
some tips to make my already working code more efficient. I am posting a
complete set up, so feel free to bail now if you want to, my need is not
urgent. I posted two Solver question earlier, to which I found an answer to
both. This is a linear blending problem using solver with VBA. I have to
analyze a table of fuels to look for a better price by blending fuels. There
are twelve of them, so rather than manually move the data around and run
solver 12 times, I thought I would give a try to writing a macro to do it.
The data are in range("A17:F30"), with A17:F17 containing the column headings
"Fuel type", "Price", "Sulphur", "Flash", "Viscosity", and "Density", in that
order. The price column is datatype = currency, the rest are number with 3
decimal places. A18:F18 are blank for the need of another macro. The values
in A19:F30 are as directly below, followed by the macro, which runs solver
against all 12 fuel types, and populates a report section with the results.
Again, this works fine for my purposes, just looking for some tips if anyone
is willing. I have tried to comment the code as best I could, and I am not
sure what it will look like when you copy and paste, so thank you to anyone
for taking a look.
1% Sulphur Fuel Oil 16.08 1.000 204.800 1.819 0.996
3% Sulphur Fuel Oil 13.25 3.000 204.800 1.819 0.996
..07% Sulphur Fuel Oil 17.33 0.700 204.800 1.819 0.996
Heating Oil 24.10 0.200 260.400 0.243 0.855
1% Vacuum Gas Oil 20.83 1.000 52.500 1.170 0.904
2% Vacuum Gas Oil 20.10 2.000 52.500 1.170 0.904
..5% Vacuum Gas Oil 21.46 0.500 52.500 1.170 0.904
Straight Run (Low Sulphur) 21.00 0.300 18.500 1.678 0.928
Straight Run (High Sulphur) 20.00 2.750 18.500 1.678 0.953
Kerosene Jet Fuel 25.52 0.125 308.800 -0.782 0.797
Diesel Fuel 24.30 0.200 161.700 -0.054 0.850
Slurry 24.10 0.200 260.400 0.243 0.855
**********************************************
Sub Macro5()
' To hold the value of the row containing the fuel currently being used by
solver.
' it will always start at row 19
Dim CurrentRow As Integer
' To hold the name of the fuel currently being analyzed by solver.
Dim CurrentFuel As String
' Set the target price. This must be at least 1 cent less than an
un-blended fuel
Dim TargetPrice As Currency
' To hold the values of the 5 attributes of the fuel currently being
analyzed.
Dim BlendPrice As Currency
Dim BlendSulphur As Double
Dim BlendFlash As Double
Dim BlendViscosity As Double
Dim BlendDensity As Double
' To hold the solver values in column G, which are the percentages of each
fuel used
' in the blend when solver has found a solution
Dim BlendQty As Double
' To hold the names of the fuels having a value > 0 in column G when
solver has found
' a solution
Dim BlendIngredient As String
' Placeholders for telling the routine where to start populating the
solver answer
Dim BlendIngredientStart As String
Dim ResultStart As String
' Set some initial values
CurrentRow = Range("A19").Row
ResultStart = Range("A36").Address
BlendIngredientStart = Range("B38").Address
' Set the formulas to make solver work
Range("B31").Formula = "=SUMPRODUCT(B19:B30,$G$19:$G$30)"
Range("C31").Formula = "=SUMPRODUCT(C19:C30,$G$19:$G$30)"
Range("D31").Formula = "=SUMPRODUCT(D19
30,$G$19:$G$30)"
Range("E31").Formula = "=SUMPRODUCT(E19:E30,$G$19:$G$30)"
Range("F31").Formula = "=SUMPRODUCT(F19:F30,$G$19:$G$30)"
Range("G31").Formula = "=SUM(G19:G30)"
' Set a hard stop for the loop. This will eventually use a variable range
using
' LastRow = .lastrow in a column or something like that
Do Until CurrentRow = 31
' Let 'er rip
CurrentFuel = Range("A" & CurrentRow).Value
Price = Range("B" & CurrentRow).Value
Sulphur = Range("C" & CurrentRow).Value
Flash = Range("D" & CurrentRow).Value
Viscosity = Range("E" & CurrentRow).Value
Density = Range("F" & CurrentRow).Value
' I would like to get rid of having to select this range. Can I do it
without selecting?
' the copy and paste bit seems to add to the clutter.
Range("B" & CurrentRow & ":F" & CurrentRow).Select
Selection.Copy
Range("B33:F33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
TargetPrice = Range("B33").Value
Range("B33").Value = TargetPrice - 0.01
' Set target cell, it is a price that must be lower than the price of the
first
' fuel used by solver.
SolverOk SetCell:="$B$31", MaxMinVal:=2, ValueOf:="0",
ByChange:="$G$19:$G$30"
' Add constraints
SolverAdd CellRef:="$B$31:$F$31", Relation:=1, FormulaText:="$B$33:$F$33"
SolverAdd CellRef:="$G$31", Relation:=2, FormulaText:=1
' Set options
SolverOptions MaxTime:=100, Iterations:=1000, Precision:=0.000001,
AssumeLinear _
:=True, StepThru:=False, Estimates:=1, Derivatives:=1,
SearchOption:=1, _
IntTolerance:=5, Scaling:=False, Convergence:=0.0001,
AssumeNonNeg:=True
' Set result variable for decision to keep solver values or start over.
' I am only interested when solver returns a 0.
' I got this from http://peltiertech.com/Excel/SolverVBA.html#Solver1, and
it worked with
' the commented out version on my work laptop, with Excel 2003, but when I
tried it on my
' personal laptop with Excel 2007, I was getting an error like "missing
something or other",
' and when I went to Tools>References, there was an entry for "MISSING
SOLVER.xla", or something
' like that, right on top of the entry for "SOLVER". I unchecked the
"MISSING" one, and checked
' "SOLVER". Then when I took out the "Solver.xla!" portion of the code,
the error went away.
' Not sure what was happening, or if the two are related.
' result = Application.Run("Solver.xla!SolverSolve", True)
result = Application.Run("SolverSolve", True)
If result = 0 Then
' Set the variable values to populate the report section.
BlendPrice = Range("B31").Value
BlendSulphur = Range("C31").Value
BlendFlash = Range("D31").Value
BlendViscosity = Range("E31").Value
BlendDensity = Range("F31").Value
' Name the first blend as to include the name of the current fuel, for
which
' solver has found a better price by making a blend.
Range(ResultStart).Value = CurrentFuel & " Substitute"
' Start populating the report section with the new blend name, and
the resulting
' values of the attributes, based on solver's solution
Range(ResultStart).Offset(0, 1).Value = BlendPrice
Range(ResultStart).Offset(0, 2).Value = BlendSulphur
Range(ResultStart).Offset(0, 3).Value = BlendFlash
Range(ResultStart).Offset(0, 4).Value = BlendViscosity
Range(ResultStart).Offset(0, 5).Value = BlendDensity
' Create headers for the blend ingredients section of the report
Range(ResultStart).Offset(1, 1).Value = "Fuel Parts"
Range(ResultStart).Offset(1, 3).Value = "Part Quantities"
' Start looking the the ByChange range for values > 0. I want to
capture
' these values as the portion of the blended fuel that is made up of
' each ingredient fuel.
Range("G19").Activate
' Give the loop a hard stop. Will be range last row driven at a later
time
Do Until ActiveCell.Address = Range("G19").Offset(12, 0).Address
If ActiveCell.Value > 0 Then
BlendQty = ActiveCell.Value
' Get the name of each ingredient fuel.
BlendIngredient = ActiveCell.Offset(0, -6).Value
' MsgBox (BlendIngredient)
' MsgBox (BlendIngredientStart)
' Populate the name of the ingredient in the report section
Range(BlendIngredientStart).Value = BlendIngredient
' Populate the ingredient portion in the report section.
Range(BlendIngredientStart).Offset(0, 2).Value = BlendQty
' Reset the variable that tell the routine where in the report
to put
' the next ingredient.
ResultStart = Range(ResultStart).Offset(2, 0).Address
BlendIngredientStart = Range(BlendIngredientStart).Offset(1,
0).Address
' Check the next cell in the ByChange range for a value > 0
ActiveCell.Offset(1, 0).Activate
Else
' Check the next cell in the ByChange range.
ActiveCell.Offset(1, 0).Activate
End If
Loop
' MsgBox ("Done with " & CurrentFuel)
' Reset the report variable for the next blended fuel, if any.
ResultStart = Range(BlendIngredientStart).Offset(1, -1).Address
' MsgBox (ResultStart)
BlendIngredientStart = Range(BlendIngredientStart).Offset(3,
0).Address
' MsgBox (BlendIngredientStart)
Else
' Clear out the ByChange range, just so it looks better.
Range("G19") = ""
Range("G20") = ""
Range("G21") = ""
Range("G22") = ""
Range("G23") = ""
Range("G24") = ""
Range("G25") = ""
Range("G26") = ""
Range("G27") = ""
Range("G28") = ""
Range("G29") = ""
Range("G30") = ""
End If
'MsgBox (CurrentFuel & " done")
' Start the process for the next fuel in the list
CurrentRow = CurrentRow + 1
Loop
End Sub
some tips to make my already working code more efficient. I am posting a
complete set up, so feel free to bail now if you want to, my need is not
urgent. I posted two Solver question earlier, to which I found an answer to
both. This is a linear blending problem using solver with VBA. I have to
analyze a table of fuels to look for a better price by blending fuels. There
are twelve of them, so rather than manually move the data around and run
solver 12 times, I thought I would give a try to writing a macro to do it.
The data are in range("A17:F30"), with A17:F17 containing the column headings
"Fuel type", "Price", "Sulphur", "Flash", "Viscosity", and "Density", in that
order. The price column is datatype = currency, the rest are number with 3
decimal places. A18:F18 are blank for the need of another macro. The values
in A19:F30 are as directly below, followed by the macro, which runs solver
against all 12 fuel types, and populates a report section with the results.
Again, this works fine for my purposes, just looking for some tips if anyone
is willing. I have tried to comment the code as best I could, and I am not
sure what it will look like when you copy and paste, so thank you to anyone
for taking a look.
1% Sulphur Fuel Oil 16.08 1.000 204.800 1.819 0.996
3% Sulphur Fuel Oil 13.25 3.000 204.800 1.819 0.996
..07% Sulphur Fuel Oil 17.33 0.700 204.800 1.819 0.996
Heating Oil 24.10 0.200 260.400 0.243 0.855
1% Vacuum Gas Oil 20.83 1.000 52.500 1.170 0.904
2% Vacuum Gas Oil 20.10 2.000 52.500 1.170 0.904
..5% Vacuum Gas Oil 21.46 0.500 52.500 1.170 0.904
Straight Run (Low Sulphur) 21.00 0.300 18.500 1.678 0.928
Straight Run (High Sulphur) 20.00 2.750 18.500 1.678 0.953
Kerosene Jet Fuel 25.52 0.125 308.800 -0.782 0.797
Diesel Fuel 24.30 0.200 161.700 -0.054 0.850
Slurry 24.10 0.200 260.400 0.243 0.855
**********************************************
Sub Macro5()
' To hold the value of the row containing the fuel currently being used by
solver.
' it will always start at row 19
Dim CurrentRow As Integer
' To hold the name of the fuel currently being analyzed by solver.
Dim CurrentFuel As String
' Set the target price. This must be at least 1 cent less than an
un-blended fuel
Dim TargetPrice As Currency
' To hold the values of the 5 attributes of the fuel currently being
analyzed.
Dim BlendPrice As Currency
Dim BlendSulphur As Double
Dim BlendFlash As Double
Dim BlendViscosity As Double
Dim BlendDensity As Double
' To hold the solver values in column G, which are the percentages of each
fuel used
' in the blend when solver has found a solution
Dim BlendQty As Double
' To hold the names of the fuels having a value > 0 in column G when
solver has found
' a solution
Dim BlendIngredient As String
' Placeholders for telling the routine where to start populating the
solver answer
Dim BlendIngredientStart As String
Dim ResultStart As String
' Set some initial values
CurrentRow = Range("A19").Row
ResultStart = Range("A36").Address
BlendIngredientStart = Range("B38").Address
' Set the formulas to make solver work
Range("B31").Formula = "=SUMPRODUCT(B19:B30,$G$19:$G$30)"
Range("C31").Formula = "=SUMPRODUCT(C19:C30,$G$19:$G$30)"
Range("D31").Formula = "=SUMPRODUCT(D19
30,$G$19:$G$30)"Range("E31").Formula = "=SUMPRODUCT(E19:E30,$G$19:$G$30)"
Range("F31").Formula = "=SUMPRODUCT(F19:F30,$G$19:$G$30)"
Range("G31").Formula = "=SUM(G19:G30)"
' Set a hard stop for the loop. This will eventually use a variable range
using
' LastRow = .lastrow in a column or something like that
Do Until CurrentRow = 31
' Let 'er rip
CurrentFuel = Range("A" & CurrentRow).Value
Price = Range("B" & CurrentRow).Value
Sulphur = Range("C" & CurrentRow).Value
Flash = Range("D" & CurrentRow).Value
Viscosity = Range("E" & CurrentRow).Value
Density = Range("F" & CurrentRow).Value
' I would like to get rid of having to select this range. Can I do it
without selecting?
' the copy and paste bit seems to add to the clutter.
Range("B" & CurrentRow & ":F" & CurrentRow).Select
Selection.Copy
Range("B33:F33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
TargetPrice = Range("B33").Value
Range("B33").Value = TargetPrice - 0.01
' Set target cell, it is a price that must be lower than the price of the
first
' fuel used by solver.
SolverOk SetCell:="$B$31", MaxMinVal:=2, ValueOf:="0",
ByChange:="$G$19:$G$30"
' Add constraints
SolverAdd CellRef:="$B$31:$F$31", Relation:=1, FormulaText:="$B$33:$F$33"
SolverAdd CellRef:="$G$31", Relation:=2, FormulaText:=1
' Set options
SolverOptions MaxTime:=100, Iterations:=1000, Precision:=0.000001,
AssumeLinear _
:=True, StepThru:=False, Estimates:=1, Derivatives:=1,
SearchOption:=1, _
IntTolerance:=5, Scaling:=False, Convergence:=0.0001,
AssumeNonNeg:=True
' Set result variable for decision to keep solver values or start over.
' I am only interested when solver returns a 0.
' I got this from http://peltiertech.com/Excel/SolverVBA.html#Solver1, and
it worked with
' the commented out version on my work laptop, with Excel 2003, but when I
tried it on my
' personal laptop with Excel 2007, I was getting an error like "missing
something or other",
' and when I went to Tools>References, there was an entry for "MISSING
SOLVER.xla", or something
' like that, right on top of the entry for "SOLVER". I unchecked the
"MISSING" one, and checked
' "SOLVER". Then when I took out the "Solver.xla!" portion of the code,
the error went away.
' Not sure what was happening, or if the two are related.
' result = Application.Run("Solver.xla!SolverSolve", True)
result = Application.Run("SolverSolve", True)
If result = 0 Then
' Set the variable values to populate the report section.
BlendPrice = Range("B31").Value
BlendSulphur = Range("C31").Value
BlendFlash = Range("D31").Value
BlendViscosity = Range("E31").Value
BlendDensity = Range("F31").Value
' Name the first blend as to include the name of the current fuel, for
which
' solver has found a better price by making a blend.
Range(ResultStart).Value = CurrentFuel & " Substitute"
' Start populating the report section with the new blend name, and
the resulting
' values of the attributes, based on solver's solution
Range(ResultStart).Offset(0, 1).Value = BlendPrice
Range(ResultStart).Offset(0, 2).Value = BlendSulphur
Range(ResultStart).Offset(0, 3).Value = BlendFlash
Range(ResultStart).Offset(0, 4).Value = BlendViscosity
Range(ResultStart).Offset(0, 5).Value = BlendDensity
' Create headers for the blend ingredients section of the report
Range(ResultStart).Offset(1, 1).Value = "Fuel Parts"
Range(ResultStart).Offset(1, 3).Value = "Part Quantities"
' Start looking the the ByChange range for values > 0. I want to
capture
' these values as the portion of the blended fuel that is made up of
' each ingredient fuel.
Range("G19").Activate
' Give the loop a hard stop. Will be range last row driven at a later
time
Do Until ActiveCell.Address = Range("G19").Offset(12, 0).Address
If ActiveCell.Value > 0 Then
BlendQty = ActiveCell.Value
' Get the name of each ingredient fuel.
BlendIngredient = ActiveCell.Offset(0, -6).Value
' MsgBox (BlendIngredient)
' MsgBox (BlendIngredientStart)
' Populate the name of the ingredient in the report section
Range(BlendIngredientStart).Value = BlendIngredient
' Populate the ingredient portion in the report section.
Range(BlendIngredientStart).Offset(0, 2).Value = BlendQty
' Reset the variable that tell the routine where in the report
to put
' the next ingredient.
ResultStart = Range(ResultStart).Offset(2, 0).Address
BlendIngredientStart = Range(BlendIngredientStart).Offset(1,
0).Address
' Check the next cell in the ByChange range for a value > 0
ActiveCell.Offset(1, 0).Activate
Else
' Check the next cell in the ByChange range.
ActiveCell.Offset(1, 0).Activate
End If
Loop
' MsgBox ("Done with " & CurrentFuel)
' Reset the report variable for the next blended fuel, if any.
ResultStart = Range(BlendIngredientStart).Offset(1, -1).Address
' MsgBox (ResultStart)
BlendIngredientStart = Range(BlendIngredientStart).Offset(3,
0).Address
' MsgBox (BlendIngredientStart)
Else
' Clear out the ByChange range, just so it looks better.
Range("G19") = ""
Range("G20") = ""
Range("G21") = ""
Range("G22") = ""
Range("G23") = ""
Range("G24") = ""
Range("G25") = ""
Range("G26") = ""
Range("G27") = ""
Range("G28") = ""
Range("G29") = ""
Range("G30") = ""
End If
'MsgBox (CurrentFuel & " done")
' Start the process for the next fuel in the list
CurrentRow = CurrentRow + 1
Loop
End Sub