Correcting "Circular Action" in Worksheet_Change

  • Thread starter Thread starter Brian
  • Start date Start date
B

Brian

I'm having a problem with the a Worksheet_Change macro. I want the code to
take the value of a cell perform a goal seek then return that value to null.

Here is the code:

Sub Worksheet_Change(ByVal Target As Range)
Dim sGoal As String, iRow As Integer

If Target.Column = 10 And Target.Row > 6 And Target.Row < 9 Then
sGoal = Target.Value
iRow = Target.Row
Select Case iRow
Case 7
Range("F36").GoalSeek Goal:=sGoal, ChangingCell:=Range("J3")
Case 8
Range("J6").GoalSeek Goal:=sGoal * 100, ChangingCell:=Range("J3")
End Select
'Range("J" & iRow).Value = ""
End If

End Sub

I'm assuming since it works fine as it is now, and it doesn't work when the
'Range line is activated, that when it goes to change the cell value back to
null, it recalls the Worksheet_Change Routine, then gives me an error on the
GoalSeek line. Any thoughts on how to do this?

Thanks in advance. And I'll be sure to check yes to answers.
 
Sub Worksheet_Change(ByVal Target As Range)
Dim sGoal As String, iRow As Integer

If Target.Column = 10 And Target.Row > 6 And Target.Row < 9 Then
Application.enableevents = false 'New code****
sGoal = Target.Value
iRow = Target.Row
Select Case iRow
Case 7
Range("F36").GoalSeek Goal:=sGoal, ChangingCell:=Range("J3")
Case 8
Range("J6").GoalSeek Goal:=sGoal * 100, ChangingCell:=Range("J3")
End Select
'Range("J" & iRow).Value = ""
Application.enableevents = true 'New code****
End If
 
Thanks Jim,

Works like a champ.
--
Brian


Jim Thomlinson said:
Sub Worksheet_Change(ByVal Target As Range)
Dim sGoal As String, iRow As Integer

If Target.Column = 10 And Target.Row > 6 And Target.Row < 9 Then
Application.enableevents = false 'New code****
sGoal = Target.Value
iRow = Target.Row
Select Case iRow
Case 7
Range("F36").GoalSeek Goal:=sGoal, ChangingCell:=Range("J3")
Case 8
Range("J6").GoalSeek Goal:=sGoal * 100, ChangingCell:=Range("J3")
End Select
'Range("J" & iRow).Value = ""
Application.enableevents = true 'New code****
End If
Click to expand...
 
Back
Top