View Full Version : Worksheet sheetchange -out of stack
cagataybaser
09-26-2014, 12:25 AM
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
Please dive into (in your Excel VBA handbook of course)
- non-contiguous ranges
- the use of With ... End With
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
09-26-2014, 05:38 AM
Cross-posted here: http://www.mrexcel.com/forum/excel-questions/807799-worksheet-sheetchange-doesnt-work.html
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
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.