VBA Goal Seek Procedure Too Large

[maomao]

Hi,

I am very new to VBA and my piece-mailing some code I found through various forums, I was able to get my VBA Goal Seek to work. However, I have too many cells I want to goal seek. I've looked into how to try to sub routine my VBA but I'm completely lost. Any help is very appreciated!!

The code goes on and on like this (note this isn't all of the VBA, but the pattern is the same all the way to the End Sub):



Private Sub Worksheet_Change(ByVal Target As Excel.Range)


If Target.Row = 248 And Target.Column = 8 Then
Range("H244").GoalSeek Goal:=Range("H248").Value, _
ChangingCell:=Range("H243")
End If
If Target.Row = 248 And Target.Column = 9 Then
Range("I244").GoalSeek Goal:=Range("I248").Value, _
ChangingCell:=Range("I243")
End If
If Target.Row = 248 And Target.Column = 10 Then
Range("J244").GoalSeek Goal:=Range("J248").Value, _
ChangingCell:=Range("J243")
End If
If Target.Row = 248 And Target.Column = 11 Then
Range("K244").GoalSeek Goal:=Range("K248").Value, _
ChangingCell:=Range("K243")
End If
If Target.Row = 248 And Target.Column = 12 Then
Range("L244").GoalSeek Goal:=Range("L248").Value, _
ChangingCell:=Range("L243")
End If
If Target.Row = 248 And Target.Column = 13 Then
Range("M244").GoalSeek Goal:=Range("M248").Value, _
ChangingCell:=Range("M243")
End If
If Target.Row = 248 And Target.Column = 14 Then
Range("N244").GoalSeek Goal:=Range("N248").Value, _
ChangingCell:=Range("N243")
End If
If Target.Row = 248 And Target.Column = 15 Then
Range("O244").GoalSeek Goal:=Range("O248").Value, _
ChangingCell:=Range("O243")
End If
If Target.Row = 248 And Target.Column = 16 Then
Range("P244").GoalSeek Goal:=Range("P248").Value, _
ChangingCell:=Range("P243")
End If
If Target.Row = 248 And Target.Column = 17 Then
Range("Q244").GoalSeek Goal:=Range("Q248").Value, _
ChangingCell:=Range("Q243")
End If
If Target.Row = 248 And Target.Column = 18 Then
Range("R244").GoalSeek Goal:=Range("R248").Value, _
ChangingCell:=Range("R243")
End If
If Target.Row = 248 And Target.Column = 19 Then
Range("S244").GoalSeek Goal:=Range("S248").Value, _
ChangingCell:=Range("S243")
End If
If Target.Row = 248 And Target.Column = 20 Then
Range("T244").GoalSeek Goal:=Range("T248").Value, _
ChangingCell:=Range("T243")
End If
If Target.Row = 248 And Target.Column = 21 Then
Range("U244").GoalSeek Goal:=Range("U248").Value, _
ChangingCell:=Range("U243")
End If
If Target.Row = 248 And Target.Column = 22 Then
Range("V244").GoalSeek Goal:=Range("V248").Value, _
ChangingCell:=Range("V243")
End If
If Target.Row = 248 And Target.Column = 23 Then
Range("W244").GoalSeek Goal:=Range("W248").Value, _
ChangingCell:=Range("W243")
End If
If Target.Row = 248 And Target.Column = 24 Then
Range("X244").GoalSeek Goal:=Range("X248").Value, _
ChangingCell:=Range("X243")
End If
If Target.Row = 248 And Target.Column = 25 Then
Range("Y244").GoalSeek Goal:=Range("Y248").Value, _
ChangingCell:=Range("Y243")
End If
If Target.Row = 248 And Target.Column = 26 Then
Range("Z244").GoalSeek Goal:=Range("Z248").Value, _
ChangingCell:=Range("Z243")
End If
If Target.Row = 248 And Target.Column = 27 Then
Range("AA244").GoalSeek Goal:=Range("AA248").Value, _
ChangingCell:=Range("AA243")
End If
If Target.Row = 248 And Target.Column = 28 Then
Range("AB244").GoalSeek Goal:=Range("AB248").Value, _
ChangingCell:=Range("AB243")
End If
If Target.Row = 248 And Target.Column = 29 Then
Range("AC244").GoalSeek Goal:=Range("AC248").Value, _
ChangingCell:=Range("AC243")
End If
If Target.Row = 248 And Target.Column = 30 Then
Range("AD244").GoalSeek Goal:=Range("AD248").Value, _
ChangingCell:=Range("AD243")
End If
If Target.Row = 248 And Target.Column = 31 Then
Range("AE244").GoalSeek Goal:=Range("AE248").Value, _
ChangingCell:=Range("AE243")
End If
If Target.Row = 248 And Target.Column = 32 Then
Range("AF244").GoalSeek Goal:=Range("AF248").Value, _
ChangingCell:=Range("AF243")
End If
If Target.Row = 248 And Target.Column = 33 Then
Range("AG244").GoalSeek Goal:=Range("AG248").Value, _
ChangingCell:=Range("AG243")
End If
If Target.Row = 248 And Target.Column = 34 Then
Range("AH244").GoalSeek Goal:=Range("AH248").Value, _
ChangingCell:=Range("AH243")
End If
If Target.Row = 248 And Target.Column = 35 Then
Range("AI244").GoalSeek Goal:=Range("AI248").Value, _
ChangingCell:=Range("AI243")
End If
If Target.Row = 248 And Target.Column = 36 Then
Range("AJ244").GoalSeek Goal:=Range("AJ248").Value, _
ChangingCell:=Range("AJ243")
End If
If Target.Row = 248 And Target.Column = 37 Then
Range("AK244").GoalSeek Goal:=Range("AK248").Value, _
ChangingCell:=Range("AK243")
End If
If Target.Row = 248 And Target.Column = 38 Then
Range("AL244").GoalSeek Goal:=Range("AL248").Value, _
ChangingCell:=Range("AL243")
End If
If Target.Row = 248 And Target.Column = 39 Then
Range("AM244").GoalSeek Goal:=Range("AM248").Value, _
ChangingCell:=Range("AM243")
End If
.
.
.
.
.
.
.
End Sub

 

[Norie]

I don't know how many columns you go up to but try this.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Target.Row = 248 And Target.Column = 7 And Target.Column<40 Then
        Target.Offset(-4).GoalSeek Goal:=Target.Value, _
            ChangingCell:=Target.Offset(-5)
    End If

End If

 

[maomao]

Hmmm that's not working (I can actually follow it though!) I'm going through 677 columns.

 

[shg]

Norie's nice compaction has a typo that would break it.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  With Target
    If .Row = 248 And .Column > 7 And .Column < 40 Then
      .Offset(-4).GoalSeek Goal:=.Value, ChangingCell:=.Offset(-5)
    End If
  End With
End Sub

 

[shg]

Change the 40 to go as far as you need.

 

[Norie]

Oops, knew I'd miss something.

 

[maomao]

YES!!! Thank you!!!!! Wow what a simple code, I really, really appreciate it!