Consulting

Results 1 to 8 of 8

Thread: Solved: Solver querstion

  1. #1
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location

    Solved: Solver querstion

    Hi,

    I am wondering if this code could be shortened:

    [VBA]Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("B7").Select
    Selection.Copy
    Range("B8:B47").Select
    ActiveSheet.Paste
    SolverOk SetCell:="$C$7", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$7"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$8", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$8"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$9", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$9"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$10", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$10"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$11", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$11"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$12", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$12"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$13", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$13"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$14", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$14"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$15", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$15"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$16", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$16"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$17", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$17"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$18", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$18"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$19", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$19"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$20", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$20"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$21", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$21"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$22", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$22"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$23", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$23"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$24", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$24"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$25", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$25"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$26", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$26"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$27", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$27"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$28", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$28"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$29", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$29"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$30", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$30"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$31", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$31"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$32", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$32"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$33", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$33"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$34", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$34"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$35", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$35"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$36", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$36"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$37", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$37"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$38", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$38"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$39", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$39"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$40", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$40"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$41", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$41"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$42", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$42"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$43", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$43"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$44", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$44"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$45", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$45"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$46", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$46"
    SolverSolve UserFinish:=True
    SolverOk SetCell:="$C$47", MaxMinVal:=3, ValueOf:="0", ByChange:="$B$47"
    SolverSolve UserFinish:=True
    ActiveWindow.SmallScroll Down:=10
    Range("F5").Select
    End Sub
    [/VBA]

  2. #2
    VBAX Master
    Joined
    Jun 2007
    Location
    East Sussex
    Posts
    1,110
    Location
    How about this:
    [VBA]Private Sub CommandButton1_Click()
    Dim i As Long
    Application.ScreenUpdating = False
    Range("B7:B47").FormulaR1C1 = "0"
    For i = 7 To 47
    SolverOk SetCell:="$C$" & i, MaxMinVal:=3, ValueOf:="0", ByChange:="$B$" & i
    SolverSolve UserFinish:=True
    Next i
    Range("F5").Select
    End Sub
    [/VBA]

    Regards,
    Rory

  3. #3
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    Nice. That did it. Thanks.

  4. #4
    VBAX Master
    Joined
    Jun 2007
    Location
    East Sussex
    Posts
    1,110
    Location
    No problem. I forgot to mention (and to put in the code!) that I recommend explicitly setting Application.ScreenUpdating back to True at the end of a routine.

  5. #5
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location

    Smile

    I caught that.

  6. #6
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    I ran into a strange situation. When I replace rory's code and run the macro all of the data on the sheet changes to zeroes. I'm attaching the workbook.

  7. #7
    VBAX Master
    Joined
    Jun 2007
    Location
    East Sussex
    Posts
    1,110
    Location
    Do you mean when you run the code in that workbook, or when you replce it with the code I posted? I can't replicate it either way - they both produce the same results for me.
    Regards,
    Rory

  8. #8
    Moderator VBAX Master austenr's Avatar
    Joined
    Sep 2004
    Location
    Maine
    Posts
    2,033
    Location
    Sorry, was away moving for a couple of days. What I should have said was when I copy the data, and chart to another worksheet, the solver wont work as it changes all of my data to zero values. I would leave them on that worksheet but there is a button that executes the solver and it is protected. Don't know the password so I can't delete it. My only other option is copy it to another sheet. The button executes the code you provided for me.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •