Workbook Sheet_Change Loop

S

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
655
I have a worksheet_Change item that is supposed to insert a timestamp (upper piece of code) and change two cells (R6 on one sheet, R9 on the rest) based on the value of another cell/sheet.

Well here's the issue- this seems to be looping so, for example, the one piece of code continually returns me to R6 (on a non-"Arrival" sheet) so I can't use any of the other cells. It's meant to change the cell as the coding below indicates and then move on to the next cell. In an ideal situation, it create this cell format when the sheet is created (via another macro) but with the ability to change (thus it's not in the creator macro) but I wasn't sure how to write that during creation piece and this looping back to R6 in this example is a problem. Ideas? Thanks for the help!

Code: 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)If sh.Name = "Developer" _
    Or sh.Name = "Notes" _
    Or sh.Name = "Ports" _
    Or sh.Name = "Voyage Specifics" _
    Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
'If Not Intersect(Target, Union(Range("R5"), Range("W25"))) Is Nothing Then
If Target.Address(0, 0) = "R5" Or Target.Address(0, 0) = "W25" Then
    If Cells(25, 23) <> "" Then
        Cells(4, 6) = Cells(25, 23).Value
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
        Cells(4, 6) = Date
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
        Cells(4, 6) = "No Data Input"
    End If
End If
  If sh.Name = "Arrival" Then
        If Cells(20, 26) <> "Yes" Then
            Range("R6").Select
            With Selection
                .Locked = False
                .ClearContents
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).ColorIndex = 0
                .Borders(xlEdgeLeft).TintAndShade = 0
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).ColorIndex = 0
                .Borders(xlEdgeRight).TintAndShade = 0
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlSolid
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.Color = 65535
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
        ElseIf Cells(20, 26) <> "No" Then
            Cells(6, 18) = "EXACT"
            Range("R6").Select
            With Selection
                .Locked = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Font.Bold = True
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlNone
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
            Range("R7").Select
        End If
    ElseIf Cells(20, 26) <> "Yes" Then
        Range("R9").Select
            With Selection
                .Locked = False
                .ClearContents
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).ColorIndex = 0
                .Borders(xlEdgeLeft).TintAndShade = 0
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).ColorIndex = 0
                .Borders(xlEdgeRight).TintAndShade = 0
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlSolid
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.Color = 65535
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
            Range("R6").Select
  ElseIf Cells(20, 26) <> "No" Then
    Cells(9, 18) = "EXACT"
        Range("R9").Select
            With Selection
                .Locked = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Font.Bold = True
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).ColorIndex = 0
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).ColorIndex = 0
                .Borders(xlEdgeBottom).TintAndShade = 0
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Interior.Pattern = xlNone
                .Interior.TintAndShade = 0
                .Interior.PatternTintAndShade = 0
            End With
            Range("R6").Select
    End If
    .EnableEvents = True
    .ScreenUpdating = True


End With
End Sub
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
It's not looping. The code is selecting R6 in 2 places where it presumably shouldn't.
Step through the code to see what's going on.
 
Upvote 0
I'm not clear what the problem is, or why you think your code is looping.

So first question:

Is it possible you have other code that is triggering the Workbook_SheetChange event?

Your various unqualified references, e.g. to Range("R6"), will refer to the ActiveSheet. This won't necessarily be the same as the worksheet sh.
 
Upvote 0
Is it possible you have other code that is triggering the Workbook_SheetChange event?
Click to expand...

Not applicable since the procedure includes : Application.EnableEvents = False

Your various unqualified references, e.g. to Range("R6"), will refer to the ActiveSheet. This won't necessarily be the same as the worksheet sh.
Click to expand...
The macro is a Workbook_SheetChange procedure, so the ActiveSheet will be the same as the worksheet sh.
 
Upvote 0
It was only a first guess, as the original question is not clear.

But it is a possibility:

Code: 
'Code module
Sub Test()

    Worksheets("Sheet1").Activate
    Worksheets("Sheet2").Range("A1").Value = "Hello"

End Sub
'This Workbook
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Application.EnableEvents = False
    
    MsgBox Sh.Name
    MsgBox ActiveSheet.Name
    
    Application.EnableEvents = True
        
End Sub
 
Upvote 0
So Looking at it here, I've deleted all of the cell "modifications" going on (i.e. within the selection) so we can see the cell selections and stuff themselves (I left 1 or 2 items within the "withs" just so I know for reference what was in each. So, as I've written the code, it should check if the sheet is named "Arrival" and if so, it should be checking if Z20 is equal to "Yes". If this is also true, Then "R6" becomes unlocked, yellow, etc etc. If "No", then "R6" becomes locked, white, and has "Exact" text put in it. After "R6" is all formatted, it should select "R7" so the user can continue with his/her inputs. (On the Arrival Sheet, R5:R13: are all input boxes for the user to input the raw data for processing).

Now if the sheet is not named "Arrival" (i.e. it's noon*), then it goes through the exact same process as above, but this time instead of "R6" being the cell to have "Exact" in it and go through color/locking changes, it instead is "R9". Now I had the "R6" select piece of code at the end of the cell mods (end With) because the user saw these changes happen after inputting data into cell "R5" on any of these sheets and the idea that the user is hitting "Enter" between inputting data, I didn't want the user to input data into "R5" on a non-Arrival sheet (i.e. noon*), hit 'Enter, and then have the cursor skip down to "R10" thus requiring the mouse/arrow keys to have to go back up and hit "R7 and R8" and input data into those skipped cells. Make sense?

Now if there was a way to tweak this coding so that, instead of these changes happening when R5 was input to, it happened when the sheet was created, that would be awesome. I didn't put them in the macro that creates the sheet itself because I want it to be able to change if "Z20" is changed from "Yes" to "No" and vice versa.

Thanks again for the help!
Code: 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)If sh.Name = "Developer" _
    Or sh.Name = "Notes" _
    Or sh.Name = "Ports" _
    Or sh.Name = "Voyage Specifics" _
    Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
If Target.Address(0, 0) = "R5" Or Target.Address(0, 0) = "W25" Then
    If Cells(25, 23) <> "" Then
        Cells(4, 6) = Cells(25, 23).Value
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
        Cells(4, 6) = Date
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
        Cells(4, 6) = "No Data Input"
    End If
End If
  If sh.Name = "Arrival" Then
        If Cells(20, 26) <> "Yes" Then
            Range("R6").Select
            With Selection
                .Locked = False
                .ClearContents
            End With
        ElseIf Cells(20, 26) <> "No" Then
            Cells(6, 18) = "EXACT"
            Range("R6").Select
            With Selection
                .Locked = True
            End With
            Range("R7").Select
        End If
    ElseIf Cells(20, 26) <> "Yes" Then
        Range("R9").Select
            With Selection
                .Locked = False
                .ClearContents
            End With
            Range("R6").Select
    ElseIf Cells(20, 26) <> "No" Then
        Cells(9, 18) = "EXACT"
        Range("R9").Select
            With Selection
                .Locked = True
            End With
        Range("R6").Select
    End If
    .EnableEvents = True
    .ScreenUpdating = True


End With
End Sub
 
Last edited:
Upvote 0
So one way of fixing this:

So the red below- the first "End If" was effectively removed and the second one added so that this runs when "R5" is checked for an input. Would be nicer if it ran when the sheet was created instead of checking "R5" for a value.

Rich (BB code): 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)If sh.Name = "Developer" _    Or sh.Name = "Notes" _
    Or sh.Name = "Ports" _
    Or sh.Name = "Voyage Specifics" _
    Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
If Target.Address(0, 0) = "R5" Or Target.Address(0, 0) = "W25" Then
    If Cells(25, 23) <> "" Then
        Cells(4, 6) = Cells(25, 23).Value
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
        Cells(4, 6) = Date
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
        Cells(4, 6) = "No Data Input"
    End If
'End If
  If sh.Name = "Arrival" Then
        If Cells(20, 26) <> "Yes" Then
            Range("R6").Select
            With Selection
                .Locked = False
                .ClearContents
            End With
        ElseIf Cells(20, 26) <> "No" Then
            Cells(6, 18) = "EXACT"
            Range("R6").Select
            With Selection
                .Locked = True
            End With
            Range("R7").Select
        End If
    ElseIf Cells(20, 26) <> "Yes" Then
        Range("R9").Select
            With Selection
                .Locked = False
                .ClearContents
            End With
            Range("R6").Select
    ElseIf Cells(20, 26) <> "No" Then
        Cells(9, 18) = "EXACT"
        Range("R9").Select
            With Selection
                .Locked = True
            End With
        Range("R6").Select
    End If
End If
    .EnableEvents = True
    .ScreenUpdating = True


End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
324
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
600
RoryA
RoryA
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
162
Joe4
Joe4
K
  • Question Question
VBA DOUBT- can we add heading color and remove blank columns in this code?
Replies
0
Views
170
Kishore1982
K
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top