Worksheet sheetchange -out of stack

[cagataybaser]

Hello Everyone I have a macro inside sheet change but it doesnt work for second time and gives out of stack
Can you help me?




Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Range("D18").Value = "no" Then
Range("D26").Interior.ColorIndex = 15
Range("D29").Interior.ColorIndex = 15
Range("D30").Interior.ColorIndex = 15
End If
If Range("D18").Value = "yes" Then
Range("D26").Interior.ColorIndex = 2
Range("D29").Interior.ColorIndex = 2
Range("D30").Interior.ColorIndex = 2
End If
Select Case Range("D4").Value
Case "Convertible"
Range("F26").Interior.ColorIndex = 2
Range("F27").Interior.ColorIndex = 2
Range("F28").Interior.ColorIndex = 2
Range("F29").Interior.ColorIndex = 2
Range("F30").Interior.ColorIndex = 2
Range("F31").Interior.ColorIndex = 2
Range("F28").Formula = "=F27*F26"
Case "3-DoorConvertible"
Range("F26").Interior.ColorIndex = 2
Range("F27").Interior.ColorIndex = 2
Range("F28").Interior.ColorIndex = 2
Range("F29").Interior.ColorIndex = 2
Range("F30").Interior.ColorIndex = 2
Range("F31").Interior.ColorIndex = 2
Range("F28").Formula = "=F27*F26"
Case "Targa"
Range("F26").Interior.ColorIndex = 2
Range("F27").Interior.ColorIndex = 2
Range("F28").Interior.ColorIndex = 2
Range("F29").Interior.ColorIndex = 2
Range("F30").Interior.ColorIndex = 2
Range("F31").Interior.ColorIndex = 2
Range("F28").Formula = "=F27*F26"
Case "Roadster"
Range("F26").Interior.ColorIndex = 2
Range("F27").Interior.ColorIndex = 2
Range("F28").Interior.ColorIndex = 2
Range("F29").Interior.ColorIndex = 2
Range("F30").Interior.ColorIndex = 2
Range("F31").Interior.ColorIndex = 2
Range("F28").Formula = "=F27*F26"
Case Else
Range("F26").Interior.ColorIndex = 15
Range("F27").Interior.ColorIndex = 15
Range("F28").Interior.ColorIndex = 15
Range("F29").Interior.ColorIndex = 15
Range("F30").Interior.ColorIndex = 15
Range("F31").Interior.ColorIndex = 15
On Error Resume Next:
Range("F28").Formula = ""
End Select
End Sub

[snb]

Please dive into (in your Excel VBA handbook of course)

- non-contiguous ranges
- the use of With ... End With

[pike]

Hi cagataybaser
of course we can help

try this code in the worksheet module where you require the changes..
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim myrange As Range
On Error Resume Next
Set myrange = Intersect(Range("D18,D4"), Target)
If Not myrange Is Nothing Then
If Range("D18").Value = "no" Then
Range("D26,D29:D30").Interior.ColorIndex = 15
ElseIf Range("D18").Value = "yes" Then
Range("D26,D29:D30").Interior.ColorIndex = 2
End If
Select Case Range("D4").Value
Case "Convertible", "3-DoorConvertible", "Targa", "Roadster"
Range("F26:F31").Interior.ColorIndex = 2
Range("F28").Formula = "=F27*F26"
Case Else
Range("F26:F31").Interior.ColorIndex = 15
Range("F28").Formula = ""
End Select
End If
End Sub

[Aflatoon]

Cross-posted here: http://www.mrexcel.com/forum/excel-questions/807799-worksheet-sheetchange-doesnt-work.html

[pike]

or in the workbook module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim myrange As Range
' On Error Resume Next
With Sheets(Sh.Name)
Set myrange = Intersect(.Range("D4,D18"), Target)
If Not myrange Is Nothing Then
If .Range("D18").Value = "no" Then
.Range("D26,D29:D30").Interior.ColorIndex = 15
ElseIf .Range("D18").Value = "yes" Then
.Range("D26,D29:D30").Interior.ColorIndex = 2
End If
Select Case .Range("D4").Value
Case "Convertible", "3-DoorConvertible", "Targa", "Roadster"
.Range("F26:F31").Interior.ColorIndex = 2
.Range("F28").Formula = "=F27*F26"
Case Else
.Range("F26:F31").Interior.ColorIndex = 15
.Range("F28").Formula = ""
End Select
End If
End With

[SamT]

Because you have not limited the procedure to any particular worksheet or Range, it will run completely thru all the code on every change on every worksheet. In addition to that, it will cause a cascade of changes (see italics above) everytime it assigns a formula to a cell, even if the formula is the same as it was.

Stack Overflow indeed.

First, insure that this sub only runs when the sheet that needs it is changed:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)If Not Sh.Name = "Sheet1" Then Exit Sub 'Edit "Sheet1" to suit.
Blah, Blah, blah
End Sub

Second, insure that it only runs when the Ranges that need it are changed.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name = "Sheet1" Then Exit Sub 'Edit "Sheet1" to suit.

Dim RangeToWatch As Range
Set RangeToWatch = Sh.Range("D4", "D18") 'Edit to Suit
If Intersect(Target, RangeToWatch) Is Nothing Then Exit Sub
Blah, Blah, blah
End Sub

Third, insure that only one instance of ther sub can run at a time

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name = "Sheet1" Then Exit Sub
Static MeAlreadyRunning As Boolean
If MeAlreadyRunning Then Exit Sub
MeAlreadyRunning = True
Dim RangeToWatch As Range

Set RangeToWatch = Sh.Range("D4", "D18") 'Edit to Suit
If Intersect(Target, RangeToWatch) Is Nothing Then Exit Sub
Blah, Blah, blah

MeAlreadyRunning = False
End Sub

Finally, insure that Excel ignores changes made by the sub when it does run all the way thru.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim RangeToWatch As Range
Static MeAlreadyRunning As Boolean

If MeAlreadyRunning Then Exit Sub
MeAlreadyRunning = True

If Not Sh.Name = "Sheet1" Then Exit Sub 'Edit "Sheet1" to suit
Set RangeToWatch = Sh.Range("D4", "D18") 'Edit to Suit
If Intersect(Target, RangeToWatch) Is Nothing Then Exit Sub

With Application
.EnableEvents = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Blah, Blah, blah

'And turn Things back on in particular order
Sh.Range("F28").Calculate
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = False
End With
MeAlreadyRunning = False
End Sub

[SamT]

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Static MeAlreadyRunning As Boolean
Const ColorOfNo As Long = 15
Const ColorOfYes As Long = 2
Dim RangeToWatch As Range
Dim YesNoRange As Range 'edit all instances to use suitible name
Dim CategoryRange As Range 'edit all instances to use suitible name

If MeAlreadyRunning Then Exit Sub
MeAlreadyRunning = True
If Not Sh.Name = "Sheet1" Then Exit Sub
Set RangeToWatch = Sh.Range("D4", "D18") 'Edit to Suit
If Intersect(Target, RangeToWatch) Is Nothing Then Exit Sub

Set YesNoRange = Sh.Range("D26, D29, D30")
Set CategoryRange = Sh.Range("F28:F31")

With Application
.EnableEvents = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
.Calculate
End With

With Sh
If .Range("D18").Value = "no" Then _
YesNoRange.Interior.ColorIndex = ColorOfNo
If .Range("D18").Value = "yes" Then _
YesNoRange.Interior.ColorIndex = ColorOfYes

Select Case .Range("D4").Value
Case "Convertible"
CategoryRange.Interior.ColorIndex = ColorOfYes
.Range("F28").Formula = "=F27*F26"
Case "3-DoorConvertible"
CategoryRange.Interior.ColorIndex = ColorOfYes
.Range("F28").Formula = "=F27*F26"
Range("F28").Formula = "=F27*F26"
Case "Targa"
CategoryRange.Interior.ColorIndex = ColorOfYes
.Range("F28").Formula = "=F27*F26"
Case "Roadster"
CategoryRange.Interior.ColorIndex = ColorOfYes
.Range("F28").Formula = "=F27*F26"
Case Else
CategoryRange.Interior.ColorIndex = ColorOfNo
On Error Resume Next
Range("F28").Formula = ""
End Select

.Range("F28").Calculate
End With

'And turn Things back on in particular order
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
MeAlreadyRunning = False
End Sub