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

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
You must log in or register to reply here.

Similar threads

S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
407
sspatriots
S
S
  • Question
Worksheet Change Event
Replies
2
Views
394
sspatriots
S
I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
287
ItalianPlatinum
I
I
  • Question
Find last row of sheet based off cell value to reference the sheet name
Replies
0
Views
219
ItalianPlatinum
I
M
  • Question
Saveas newwb, close new wb, delete old wb
Replies
8
Views
219
eiloken
E

Forum statistics

Threads
1,215,465
Messages
6,124,977
Members
449,200
Latest member
Jamil ahmed

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