wdobson17
08-19-2012, 04:44 PM
Hello! I am trying to model the temperature differential of a pipeline across approximately 243km. To do this I've broken down the pipeline into different segments and the equations I'm using require guessing the equating the numbers to each other. I've been successful in getting all the different segments to converge and work independently, but if I chose to shorten the iterations I'm going to end up with a monstrous code. I'm relatively new to VBA and am trying to reach back to the couple classes I took in college to understand what I need to do. Below is my code as I've completed it so far, it works for the most part, but there's got to be a way to make it shorter. Hope anyone can help!
Sub LCS2LIND()
Dim GSCOLE As Range
Dim fturb As Range
Set GSCOLE = Sheets("Summer").Range("B31:I31")
Set fturb = Sheets("Summer").Range("B29:I31")
'Segment 1
Static isWorking As Boolean
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("B31").GoalSeek Goal:=1, ChangingCell:=Range("B29")
isWorking = False
End If
SolverAdd CellRef:="$B$4", Relation:=2, FormulaText:="$B$3"
SolverOk SetCell:="$B$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$3"
SolverSolve
'Segment 2
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("C31").GoalSeek Goal:=1, ChangingCell:=Range("C29")
isWorking = False
End If
SolverAdd CellRef:="$C$4", Relation:=2, FormulaText:="$C$3"
SolverOk SetCell:="$C$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$C$3"
SolverSolve
'Segment 3
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("D31").GoalSeek Goal:=1, ChangingCell:=Range("D29")
isWorking = False
End If
SolverAdd CellRef:="$D$4", Relation:=2, FormulaText:="$D$3"
SolverOk SetCell:="$D$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$D$3"
SolverDelete CellRef:="$C$4", Relation:=2, FormulaText:="$C$3"
SolverSolve
'Segment 4
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("E31").GoalSeek Goal:=1, ChangingCell:=Range("E29")
isWorking = False
End If
SolverAdd CellRef:="$E$4", Relation:=2, FormulaText:="$E$3"
SolverOk SetCell:="$E$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$E$3"
SolverDelete CellRef:="$D$4", Relation:=2, FormulaText:="$D$3"
SolverSolve
'Segment 5
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("F31").GoalSeek Goal:=1, ChangingCell:=Range("F29")
isWorking = False
End If
SolverAdd CellRef:="$F$4", Relation:=2, FormulaText:="$F$3"
SolverOk SetCell:="$F$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$F$3"
SolverDelete CellRef:="$D$4", Relation:=2, FormulaText:="$D$3"
SolverSolve
'Segment 6
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("G31").GoalSeek Goal:=1, ChangingCell:=Range("G29")
isWorking = False
End If
SolverAdd CellRef:="$G$4", Relation:=2, FormulaText:="$G$3"
SolverOk SetCell:="$G$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$G$3"
SolverDelete CellRef:="$F$4", Relation:=2, FormulaText:="$F$3"
SolverSolve
'Segment 7
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("H31").GoalSeek Goal:=1, ChangingCell:=Range("H29")
isWorking = False
End If
SolverAdd CellRef:="$H$4", Relation:=2, FormulaText:="$H$3"
SolverOk SetCell:="$H$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$H$3"
SolverDelete CellRef:="$G$4", Relation:=2, FormulaText:="$G$3"
SolverSolve
'Segment 8
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("I31").GoalSeek Goal:=1, ChangingCell:=Range("I29")
isWorking = False
End If
SolverAdd CellRef:="$I$4", Relation:=2, FormulaText:="$I$3"
SolverOk SetCell:="$I$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$I$3"
SolverDelete CellRef:="$H$4", Relation:=2, FormulaText:="$H$3"
SolverSolve
End Sub
Sub LCS2LIND()
Dim GSCOLE As Range
Dim fturb As Range
Set GSCOLE = Sheets("Summer").Range("B31:I31")
Set fturb = Sheets("Summer").Range("B29:I31")
'Segment 1
Static isWorking As Boolean
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("B31").GoalSeek Goal:=1, ChangingCell:=Range("B29")
isWorking = False
End If
SolverAdd CellRef:="$B$4", Relation:=2, FormulaText:="$B$3"
SolverOk SetCell:="$B$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$B$3"
SolverSolve
'Segment 2
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("C31").GoalSeek Goal:=1, ChangingCell:=Range("C29")
isWorking = False
End If
SolverAdd CellRef:="$C$4", Relation:=2, FormulaText:="$C$3"
SolverOk SetCell:="$C$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$C$3"
SolverSolve
'Segment 3
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("D31").GoalSeek Goal:=1, ChangingCell:=Range("D29")
isWorking = False
End If
SolverAdd CellRef:="$D$4", Relation:=2, FormulaText:="$D$3"
SolverOk SetCell:="$D$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$D$3"
SolverDelete CellRef:="$C$4", Relation:=2, FormulaText:="$C$3"
SolverSolve
'Segment 4
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("E31").GoalSeek Goal:=1, ChangingCell:=Range("E29")
isWorking = False
End If
SolverAdd CellRef:="$E$4", Relation:=2, FormulaText:="$E$3"
SolverOk SetCell:="$E$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$E$3"
SolverDelete CellRef:="$D$4", Relation:=2, FormulaText:="$D$3"
SolverSolve
'Segment 5
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("F31").GoalSeek Goal:=1, ChangingCell:=Range("F29")
isWorking = False
End If
SolverAdd CellRef:="$F$4", Relation:=2, FormulaText:="$F$3"
SolverOk SetCell:="$F$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$F$3"
SolverDelete CellRef:="$D$4", Relation:=2, FormulaText:="$D$3"
SolverSolve
'Segment 6
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("G31").GoalSeek Goal:=1, ChangingCell:=Range("G29")
isWorking = False
End If
SolverAdd CellRef:="$G$4", Relation:=2, FormulaText:="$G$3"
SolverOk SetCell:="$G$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$G$3"
SolverDelete CellRef:="$F$4", Relation:=2, FormulaText:="$F$3"
SolverSolve
'Segment 7
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("H31").GoalSeek Goal:=1, ChangingCell:=Range("H29")
isWorking = False
End If
SolverAdd CellRef:="$H$4", Relation:=2, FormulaText:="$H$3"
SolverOk SetCell:="$H$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$H$3"
SolverDelete CellRef:="$G$4", Relation:=2, FormulaText:="$G$3"
SolverSolve
'Segment 8
If Round(Range("J22").Value, 6) <> 1 And Not isWorking Then
isWorking = True
Range("I31").GoalSeek Goal:=1, ChangingCell:=Range("I29")
isWorking = False
End If
SolverAdd CellRef:="$I$4", Relation:=2, FormulaText:="$I$3"
SolverOk SetCell:="$I$4", MaxMinVal:=1, ValueOf:="0", ByChange:="$I$3"
SolverDelete CellRef:="$H$4", Relation:=2, FormulaText:="$H$3"
SolverSolve
End Sub