Solver and vba in excel 2007

M

mexicanabeibi

New Member
Joined
Oct 18, 2011
Messages
1
This is a product mix problem and I want to run solver 10 times but not overwrite my existing results...I have been working on this for a very long time and I am just stuck. I need solver to find optimal profits when the resources are increased by 10%, 20%, 30%...100%. Then I want to put the results onto a separate worksheet so I can create a graph. I tried just running solver twice but it overwrote my old results but should I even try to run it 10 times? Here's my code for reference:
Code: 
<c>Option Explicit
Option Base 1

' Definition of main variables:
'   nProducts - number of products listed in Data sheet
'   nResources - number of resources listed in Data sheet
'   product() - array of product names
'   resource() - array of resource names
Public nProducts As Integer, nResources As Integer
Public product() As String, resource() As String

Sub MainProductMix()
    ' This sub runs when the user clicks on the button on the Explanation sheet.
    Call GetProducts
    Call GetResources
    Call SetupModel
    Call RunSolver
    Call RunSolver1
    Call CreateReport
    Call Sensitivity
    
End Sub

Sub GetProducts()
    ' This sub finds the number of products and their corresponding data.
    With Range("ProdAnchor")
        nProducts = Range(.Offset(1, 0), .End(xlDown)).Count
        ReDim product(nProducts)
        Dim p As Integer ' product index
        For p = 1 To nProducts
            product(p) = .Offset(p, 1).Value
        Next
    End With
End Sub

Sub GetResources()
    ' This sub finds the number of resources and their corresponding data.
    With Range("ResAnchor")
        nResources = Range(.Offset(1, 0), .End(xlDown)).Count
        ReDim resource(nResources)
        Dim r As Integer ' resource index
        For r = 1 To nResources
            resource(r) = .Offset(r, 0).Value
        Next
    End With
End Sub

Sub SetupModel()
    ' This sub develops the optimization model through a series of subroutines.
    With Worksheets("Model")
        .Visible = True
        .Activate
    End With
    Call ClearOldModel
    Call EnterProductData
    Call EnterResourceData
    Call EnterUsageData
    Call CalcMaxProduction
    Call CalcResourceUsages
    Call CalcMonetaryValues
End Sub

Sub ClearOldModel()
    ' This sub clears all of the old data, but not formatting,
    ' from any previous model.
    With Range("ProdMixAnchor")
        Range(.Offset(1, 1), .Offset(10, 1).End(xlToRight)).ClearContents
    End With
    With Range("ResUseAnchor")
        Range(.Offset(1, 0), .Offset(1, 0).End(xlDown).Offset(0, 3).Offset(0, 4).Offset(0, 5).Offset(0, 6).Offset(0, 7).Offset(0, 8)).ClearContents
    End With
    With Range("MonSummAnchor")
        Range(.Offset(1, 1), .Offset(3, 1)).ClearContents
        Range(.Offset(4, 1), .Offset(4, 1).End(xlDown)).ClearContents
    End With
    With Range("UnitUseAnchor")
        Range(.Offset(0, 0), .End(xlDown).End(xlToRight)).ClearContents
        .Value = "Resource/Product code"
    End With
End Sub

Sub EnterProductData()
    ' This sub enters the product data for all products selected in the
    ' Product Mix part of the Model sheet.
    Dim p1 As Integer ' product index
    Dim p2 As Integer ' product index, all products
    Dim minVal As Single

    ' Enter data only for products
    p1 = 0
    With Range("ProdMixAnchor")
        For p2 = 1 To nProducts
            If p2 Then
                p1 = p1 + 1

                ' Enter product code.
                .Offset(1, p1).Value = Range("ProdAnchor") _
                    .Offset(p2, 0).Value

                ' Enter minimum production level.
                ' (Enter 0 if one isn't given in the Data sheet).
                If Range("ProdAnchor").Offset(p2, 4).Value = "" Then
                    minVal = 0
                Else
                    minVal = Range("ProdAnchor").Offset(p2, 4).Value
                End If
                .Offset(2, p1).Value = minVal

                ' Set the initial values of the changing cells to 0.
                .Offset(4, p1).Value = 0

                ' Enter labels to identify constraints.
                .Offset(3, p1).Value = "<="
                .Offset(5, p1).Value = "<="

                ' Enter unit price and unit cost.
                .Offset(8, p1).Value = Range("ProdAnchor") _
                    .Offset(p2, 2).Value
                .Offset(9, p1).Value = Range("ProdAnchor") _
                    .Offset(p2, 3).Value

                ' Calculate unit profit.
                .Offset(10, p1).FormulaR1C1 = "=R[-2]C-R[-1]C"
            End If
        Next

        ' Name various ranges.
        Range(.Offset(2, 1), .Offset(2, 1).End(xlToRight)).Name = "MinProd"
        Range(.Offset(4, 1), .Offset(4, 1).End(xlToRight)).Name = "Produced"
        Range(.Offset(8, 1), .Offset(8, 1).End(xlToRight)).Name = "UnitRev"
        Range(.Offset(9, 1), .Offset(9, 1).End(xlToRight)).Name = "UnitCost"
        Range(.Offset(10, 1), .Offset(10, 1).End(xlToRight)).Name = "UnitProfit"
    End With
End Sub

Sub EnterResourceData()
    ' This sub enters the resources availabilities in the Resource
    ' Usage part of the Model sheet.
    Dim r As Integer ' resource index
    Dim availAddress As String

    With Range("ResUseAnchor")
        For r = 1 To nResources
            ' Enter name of resource.
            .Offset(r, 0).Value = resource(r)

            ' Enter label to identify constraint.
            .Offset(r, 2).Value = "<="
            .Offset(r, 5).Value = "<="
            .Offset(r, 8).Value = "<="
            .Offset(r, 11).Value = "<="
            .Offset(r, 14).Value = "<="
            .Offset(r, 17).Value = "<="
            .Offset(r, 20).Value = "<="
            .Offset(r, 23).Value = "<="
            .Offset(r, 26).Value = "<="
            .Offset(r, 29).Value = "<="
            .Offset(r, 32).Value = "<="

            ' Enter resource availability.
            .Offset(r, 3).Value = Range("ResAnchor").Offset(r, 2).Value
            'Calculate resource availability 1 to 100 percent
            Range("Available1").Cells(r).FormulaR1C1 = "=RC[-3]*1.1"
            Range("Available2").Cells(r).FormulaR1C1 = "=RC[-6]*1.2"
            Range("Available3").Cells(r).FormulaR1C1 = "=RC[-9]*1.3"
            Range("Available4").Cells(r).FormulaR1C1 = "=RC[-12]*1.4"
            Range("Available5").Cells(r).FormulaR1C1 = "=RC[-15]*1.5"
            Range("Available6").Cells(r).FormulaR1C1 = "=RC[-18]*1.6"
            Range("Available7").Cells(r).FormulaR1C1 = "=RC[-21]*1.7"
            Range("Available8").Cells(r).FormulaR1C1 = "=RC[-24]*1.8"
            Range("Available9").Cells(r).FormulaR1C1 = "=RC[-27]*1.9"
            Range("Available10").Cells(r).FormulaR1C1 = "=RC[-30]*2"
            
        Next

        ' Name resource ranges.
        Range(.Offset(1, 1), .Offset(nResources, 1)).Name = "Used"
        Range(.Offset(1, 3), .Offset(nResources, 3)).Name = "Available"
        Range(.Offset(1, 4), .Offset(nResources, 4)).Name = "Used1"
        Range(.Offset(1, 6), .Offset(nResources, 6)).Name = "Available1"
        Range(.Offset(1, 7), .Offset(nResources, 7)).Name = "Used2"
        Range(.Offset(1, 9), .Offset(nResources, 9)).Name = "Available2"
        Range(.Offset(1, 10), .Offset(nResources, 10)).Name = "Used3"
        Range(.Offset(1, 12), .Offset(nResources, 12)).Name = "Available3"
        Range(.Offset(1, 13), .Offset(nResources, 13)).Name = "Used4"
        Range(.Offset(1, 15), .Offset(nResources, 15)).Name = "Available4"
        Range(.Offset(1, 16), .Offset(nResources, 16)).Name = "Used5"
        Range(.Offset(1, 18), .Offset(nResources, 18)).Name = "Available5"
        Range(.Offset(1, 19), .Offset(nResources, 19)).Name = "Used6"
        Range(.Offset(1, 21), .Offset(nResources, 21)).Name = "Available6"
        Range(.Offset(1, 22), .Offset(nResources, 22)).Name = "Used7"
        Range(.Offset(1, 24), .Offset(nResources, 24)).Name = "Available7"
        Range(.Offset(1, 25), .Offset(nResources, 25)).Name = "Used8"
        Range(.Offset(1, 27), .Offset(nResources, 27)).Name = "Available8"
        Range(.Offset(1, 28), .Offset(nResources, 28)).Name = "Used9"
        Range(.Offset(1, 30), .Offset(nResources, 30)).Name = "Available9"
        Range(.Offset(1, 31), .Offset(nResources, 31)).Name = "Used10"
        Range(.Offset(1, 33), .Offset(nResources, 33)).Name = "Available10"
    End With
End Sub

Sub EnterUsageData()
    ' This sub enters the unit usages of resources for selected products
    ' in the resource usage part of the Model sheet.
    Dim p1 As Integer ' product index
    Dim p2 As Integer ' product index, all products
    Dim r As Integer ' resource index

    With Range("UnitUseAnchor")
        ' Enter resource names.
        For r = 1 To nResources
            .Offset(r, 0).Value = resource(r)
        Next

        ' Enter data only for selected products.
        p1 = 0
        For p2 = 1 To nProducts
            If p2 Then
                p1 = p1 + 1

                ' Enter product code.
                .Offset(0, p1).Value = Range("ProdAnchor") _
                    .Offset(p2, 0).Value

                ' Enter unit usages of all resources used by this product.
                For r = 1 To nResources
                    .Offset(r, p1).Value = Range("ProdAnchor") _
                        .Offset(p2, 5 + r).Value
                Next
            End If
        Next
    End With
End Sub

Sub CalcMaxProduction()
    ' This sub calculates the max production levels for all products.
    Dim p1 As Integer ' product index
    Dim p2 As Integer ' product index, all products
    Dim r As Integer ' resource index
    Dim maxVal As Single
    Dim unitUse As Single
    Dim ratio As Single

    ' Enter data only for all products
    p1 = 0
    With Range("ProdMixAnchor")
        For p2 = 1 To nProducts
            If p2 Then
                p1 = p1 + 1
                If Range("ProdAnchor").Offset(p2, 5).Value = "" Then

                    ' No maximum production level was given, so find how much of
                    ' this product could be produced if all of the resources were
                    ' devoted to it, and use this as a maximum production level.
                    maxVal = 1000000
                    For r = 1 To nResources
                        unitUse = Range("UnitUseAnchor").Offset(r, p1).Value
                        If unitUse > 0 Then
                            ratio = Range("Available").Cells(r).Value / unitUse
                            If ratio < maxVal Then maxVal = ratio
                        End If
                    Next

                    ' Enter calculated maximum production level
                    ' (rounded down to nearest integer).
                    .Offset(6, p1).Value = Int(maxVal)

                Else
                    ' The maximum production level was given, so enter it.
                    .Offset(6, p1).Value = Range("ProdAnchor") _
                        .Offset(p2, 5).Value
                End If
            End If
        Next

        ' Name the range of maximum production levels.
        Range(.Offset(6, 1), .Offset(6, 1).End(xlToRight)).Name = "MaxProd"
    End With
End Sub

Sub CalcResourceUsages()
    ' This sub calculates the resource usage for each resource by using a Sumproduct function.
    ' Note how the address of the row of unit usages for resource i is found first,
    ' then used as part of the formula string.
    Dim r As Integer ' resource index
    Dim unitUseAddress As String

    With Range("UnitUseAnchor")
        For r = 1 To nResources
            unitUseAddress = Range(.Offset(r, 1), .Offset(r, 1).End(xlToRight)).Address
            Range("Used").Cells(r).Formula = "=Sumproduct(Produced," & unitUseAddress & ")"
Range("Used1").Cells(r).Formula = "=Sumproduct(Produced," & unitUseAddress & ")"
        Next
    End With
End Sub

Sub CalcMonetaryValues()
    ' This sub calculates the summary monetary values.
    With Range("MonSummAnchor")
        .Offset(1, 1).Formula = "=Sumproduct(Produced,UnitRev)"
        .Offset(2, 1).Formula = "=Sumproduct(Produced,UnitCost)"
        .Offset(3, 1).Formula = "=Sumproduct(Produced,UnitProfit)"
        .Offset(4, 1).Formula = "=Sumproduct(Produced,UnitProfit)"
 

        ' Name the monetary cells.
        .Offset(1, 1).Name = "TotRev"
        .Offset(2, 1).Name = "TotCost"
        .Offset(3, 1).Name = "TotProfit"
        .Offset(4, 1).Name = "TotProfit1"
        .Offset(3, 1).Name = "TotProfit2"
        .Offset(4, 1).Name = "TotProfit3"
        .Offset(3, 1).Name = "TotProfit4"
        .Offset(4, 1).Name = "TotProfit5"
        .Offset(3, 1).Name = "TotProfit6"
        .Offset(4, 1).Name = "TotProfit7"
        .Offset(3, 1).Name = "TotProfit8"
        .Offset(4, 1).Name = "TotProfit9"
        .Offset(3, 1).Name = "TotProfit10"
        
    End With
End Sub

Sub RunSolver()
    ' This sub sets up and runs Solver.
    Dim solverStatus As Integer

    ' Reset Solver settings, then set up Solver.
    SolverReset
    SolverOk SetCell:=Range("TotProfit"), MaxMinVal:=1, ByChange:=Range("Produced")

    ' Add constraints.
    SolverAdd CellRef:=Range("Produced"), Relation:=3, _
        FormulaText:=Range("MinProd").Address
    SolverAdd CellRef:=Range("Produced"), Relation:=1, _
        FormulaText:=Range("MaxProd").Address
    SolverAdd CellRef:=Range("Used"), Relation:=1, _
        FormulaText:=Range("Available").Address

    ' Comment out the next line if you don't want integer constraints on production.
    SolverAdd CellRef:=Range("Produced"), Relation:=4
    SolverOptions AssumeLinear:=True, AssumeNonNeg:=True

    ' Run Solver and check for infeasibility.
    solverStatus = SolverSolve(UserFinish:=True)
    If solverStatus = 5 Then
        ' There is no feasible solution, so report this, tidy up, and quit.
        MsgBox "This model has no feasible solution. Change the data " _
            & "in the Data sheet and try running it again.", _
            vbInformation, "No feasible solution"
        Worksheets("Explanation").Activate
        Range("A1").Select
        Worksheets("Model").Visible = True
        Worksheets("Report").Visible = False
        Worksheets("SensitivityReport").Visible = False
        End
    End If
End Sub
Sub RunSolver1()

    ' This sub sets up and runs Solver.
    Dim solverStatus1 As Integer

    ' Reset Solver settings, then set up Solver.
    SolverReset
    SolverOk SetCell:=Range("TotProfit1"), MaxMinVal:=1, ByChange:=Range("Produced")

    ' Add constraints.
    SolverAdd CellRef:=Range("Produced"), Relation:=3, _
        FormulaText:=Range("MinProd").Address
    SolverAdd CellRef:=Range("Produced"), Relation:=1, _
        FormulaText:=Range("MaxProd").Address
    SolverAdd CellRef:=Range("Used1"), Relation:=1, _
        FormulaText:=Range("Available1").Address

    ' Comment out the next line if you don't want integer constraints on production.
    SolverAdd CellRef:=Range("Produced"), Relation:=4
    SolverOptions AssumeLinear:=True, AssumeNonNeg:=True

    ' Run Solver and check for infeasibility.
    solverStatus1 = SolverSolve(UserFinish:=True)
    If solverStatus1 = 5 Then
        ' There is no feasible solution, so report this, tidy up, and quit.
        MsgBox "This model has no feasible solution. Change the data " _
            & "in the Data sheet and try running it again.", _
            vbInformation, "No feasible solution"
        Worksheets("Explanation").Activate
        Range("A1").Select
        Worksheets("Model").Visible = True
        Worksheets("Report").Visible = False
        Worksheets("SensitivityReport").Visible = False
        End
    End If

End Sub


Sub CreateReport()
    ' This sub fills in the Report sheet, mostly by transferring the
    ' results from the Model sheet.

    ' Hide Model sheet.
    Worksheets("Model").Visible = True

    ' Unhide and activate Report sheet.
    With Worksheets("Report")
        .Visible = True
        .Activate
    End With

    ' Enter results in three steps.
    Call EnterMonetaryResults
    Call EnterProductResults
    Call EnterResourceResults

    ' Make sure columns B and H are wide enough, then select cell A1.
    Columns("B:B").Columns.AutoFit
    Columns("H:H").Columns.AutoFit
    Range("A1").Select
End Sub

Sub EnterMonetaryResults()
    ' This sub transfers the total revenue, total cost, and total profit.
    Dim i As Integer
    With Range("B3")
        For i = 1 To 3
            .Offset(i, 0).Value = Range("MonSummAnchor").Offset(i, 1).Value
        Next
    End With
End Sub

Sub EnterProductResults()
    ' This sub transfers results for the products in the optimal product mix.
    Dim p1 As Integer ' product index, selected products only
    Dim p2 As Integer ' product index, all products

    With Range("ProdRepAnchor")
        ' Clear old data (if any).
        Range(.Offset(1, 0), .Offset(1, 0).End(xlDown).End(xlToRight)) _
            .ClearContents

        ' Enter results for all products
        p1 = 0
        For p2 = 1 To nProducts
            If p2 Then
                p1 = p1 + 1

                ' Enter product code, description, and number of units produced.
                .Offset(p1, 0).Value = Range("ProdAnchor").Offset(p2, 0).Value
                .Offset(p1, 1) = Range("ProdAnchor").Offset(p2, 1)
                .Offset(p1, 2).Value = Range("Produced").Cells(p1).Value

                ' Calculate revenue, cost, and profit for the product.
                .Offset(p1, 3).Value = Range("Produced").Cells(p1).Value * _
                    Range("UnitRev").Cells(p1).Value
                .Offset(p1, 4).Value = Range("Produced").Cells(p1).Value * _
                    Range("UnitCost").Cells(p1)
                .Offset(p1, 5) = Range("Produced").Cells(p1).Value * _
                    Range("UnitProfit").Cells(p1).Value
            End If
        Next
    End With
End Sub

Sub EnterResourceResults()
    ' This sub transfers results about resource usage.
    Dim r As Integer ' resource index

    With Range("ResRepAnchor")
        ' Clear old data (if any).
        Range(.Offset(1, 0), .Offset(1, 0).End(xlDown).End(xlToRight)).ClearContents
        For r = 1 To nResources

            ' Enter resource name, amount used, and amount available.
            .Offset(r, 0) = Range("ResAnchor").Offset(r, 0).Value
            .Offset(r, 1) = Range("Used").Cells(r).Value
            .Offset(r, 2) = Range("Available").Cells(r).Value
            ' Calculate amount left over.
            .Offset(r, 3).FormulaR1C1 = "=RC[-1]-RC[-2]"
        Next
    End With
End Sub

Sub Sensitivity()
Worksheets("SensitivityReport").Visible = False

With Worksheets("SensitivityReport")
        .Visible = True
        .Activate
End With

End Sub
</c>
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
You must log in or register to reply here.

Similar threads

V
  • Question Question
VBA excel worksheet2 out of range even though the cell is within the range and additional value created
Replies
4
Views
213
MARK858
MARK858
J
  • Solved
Run time error for Worksheet Change in VBA
2
Replies
17
Views
395
jtemp57
J
Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
412
Sean15
Sean15
E
  • Solved
Is there a preference to call/address variables vs cells?
Replies
6
Views
203
EssKayKay
E
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
313
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,229
Messages
6,170,881
Members
452,364
Latest member
springate

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top