Help with More than one Worksheet_Change Private Sub

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
141
Office Version
  1. 2013
Platform
  1. Windows
Hi. I have a private sub Worksheet_Change(ByVal Target As Range) looking at the last value in a column range which fires other macros when various cases are met. This works fine. I am now trying to add another set of cases to a different cell to fire when the text in that cell (generated by Excel formula) matches the new cases. I am having difficutly getting it to work and think I am definetely screwing up somewhere. Here is the working code without the new code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim triggercells As Range, lrow As Integer
    
    Set triggercells = Range("M4:M53")
    
    If Not Application.Intersect(triggercells, Range(Target.Address)) Is Nothing Then
        lrow = Cells(Rows.Count, "M").End(xlUp).Row
        If Target.Row = lrow Then
            Application.EnableEvents = False
            Select Case Target.Value
                Case "NOON in PORT", "NOON in TRANS", "ROP", "ROP2"
                    Range("I5,E4:F4,E5:F5").ClearContents
                Case Else
                    ' No Action Required
            End Select
                     
            On Error Resume Next
                Range("D22").Comment.Delete
                Range("D23").Comment.Delete
                Range("D25").Comment.Delete
                Range("D26").Comment.Delete
            On Error GoTo 0
    
             Dim cmtCell As Range
            Select Case Target.Value
                Case "SOP"
                    Set cmtCell = Range("D22")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP
                Case "ROP"
                    Set cmtCell = Range("D23")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP
                Case "SOP2"
                    Set cmtCell = Range("D25")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP2
                Case "ROP2"
                    Set cmtCell = Range("D26")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP2
                Case "NOON in PORT"
                    Call TalkNOONinPORT
                Case "NOON at SEA"
                    Call TalkNOONatSEA
                Case "NOON in TRANS"
                    Call TalkNOONinTRANS
                Case "EOP"
                    Call TalkEOP
                Case "FAOP"
                    Call TalkFAOP
                    Case Else
                 ' Comment already deleted as initialisation step
            End Select
                         
            Range("j13").Select
            
            Application.EnableEvents = True
        End If
    End If

End Sub
The above works fine.

What I'd like to do is have another set of events fire a set of macros with the following details:
Trigger Cell is G1 so when G1 = the following cases:
Case 1 = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" to call Macro1
Case 2 = "Domestic Water Consumption is High. Please Give a Reason in the Message Box" to call Macro2
Case 3 = "Domestic & Distilled Water Consumption is High. Please Give a Reason in the Message Box" to call Macro3

I am trying to add the following code before Range("j13").Select just for the first case, but it's not working:
VBA Code:
 Dim WaterCell As Range
          If Not Application.Intersect(WaterCell, Range(Target.Address)) Is Nothing Then
          Select Case Target.Value
          Case "Distilled Water Consumption is High. Please Give a Reason in the Message Box"
          Set WaterCell = Range("G1")
          Call TalkDistilled
          Case Else
          End Select

What am I doing wrong? Thanks
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
So I found for the first case using this code works fine:

VBA Code:
   Dim WaterCell As Range
          
          Set WaterCell = Range("G1")
          If Target.Value = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" Then
          Call TalkDistilled
          Else
          End If

The problem is, how to incorporate this into the original code as one Worksheet_Change private sub?
 
Upvote 0
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lrow As Integer
   
    If Not Application.Intersect(Range("G1"), Target) Is Nothing Then
        If Target.Value = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" Then Call TalkDistilled
    
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
        lrow = Cells(Rows.Count, "M").End(xlUp).Row
        If Target.Row = lrow Then
            Application.EnableEvents = False
            Select Case Target.Value
                Case "NOON in PORT", "NOON in TRANS", "ROP", "ROP2"
                    Range("I5,E4:F4,E5:F5").ClearContents
                Case Else
                    ' No Action Required
            End Select
                    
            On Error Resume Next
                Range("D22").Comment.Delete
                Range("D23").Comment.Delete
                Range("D25").Comment.Delete
                Range("D26").Comment.Delete
            On Error GoTo 0
   
             Dim cmtCell As Range
            Select Case Target.Value
                Case "SOP"
                    Set cmtCell = Range("D22")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP
                Case "ROP"
                    Set cmtCell = Range("D23")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP
                Case "SOP2"
                    Set cmtCell = Range("D25")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP2
                Case "ROP2"
                    Set cmtCell = Range("D26")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP2
                Case "NOON in PORT"
                    Call TalkNOONinPORT
                Case "NOON at SEA"
                    Call TalkNOONatSEA
                Case "NOON in TRANS"
                    Call TalkNOONinTRANS
                Case "EOP"
                    Call TalkEOP
                Case "FAOP"
                    Call TalkFAOP
                    Case Else
                 ' Comment already deleted as initialisation step
            End Select
                        
            Range("j13").Select
           
            Application.EnableEvents = True
        End If
       
    End If

End Sub
 
Upvote 0
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lrow As Integer
  
    If Not Application.Intersect(Range("G1"), Target) Is Nothing Then
        If Target.Value = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" Then Call TalkDistilled
    
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
        lrow = Cells(Rows.Count, "M").End(xlUp).Row
        If Target.Row = lrow Then
            Application.EnableEvents = False
            Select Case Target.Value
                Case "NOON in PORT", "NOON in TRANS", "ROP", "ROP2"
                    Range("I5,E4:F4,E5:F5").ClearContents
                Case Else
                    ' No Action Required
            End Select
                   
            On Error Resume Next
                Range("D22").Comment.Delete
                Range("D23").Comment.Delete
                Range("D25").Comment.Delete
                Range("D26").Comment.Delete
            On Error GoTo 0
  
             Dim cmtCell As Range
            Select Case Target.Value
                Case "SOP"
                    Set cmtCell = Range("D22")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP
                Case "ROP"
                    Set cmtCell = Range("D23")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP
                Case "SOP2"
                    Set cmtCell = Range("D25")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkSOP2
                Case "ROP2"
                    Set cmtCell = Range("D26")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                    Call TalkROP2
                Case "NOON in PORT"
                    Call TalkNOONinPORT
                Case "NOON at SEA"
                    Call TalkNOONatSEA
                Case "NOON in TRANS"
                    Call TalkNOONinTRANS
                Case "EOP"
                    Call TalkEOP
                Case "FAOP"
                    Call TalkFAOP
                    Case Else
                 ' Comment already deleted as initialisation step
            End Select
                       
            Range("j13").Select
          
            Application.EnableEvents = True
        End If
      
    End If

End Sub
Thanks very much for your reply, very much appreciated.
This works when the exact text is typed in. However, I have this formula in G1 to generate the text, and it doesn't seem to work when the forumula generates it? This is the formula for the 3 cases.
Excel Formula:
=IF(AND($J$3>15,$J$4<16),"Distilled Water Consumption is High. Please Give a Reason in the Message Box",IF(AND($J$4>15,$J$3<16),"Domestic Water Consumption is High. Please Give a Reason in the Message Box",IF(AND($J$3>15,$J$4>15),"Domestic & Distilled Water Consumption is High. Please Give a Reason in the Message Box","Previous Day's ROBs Will Update After Clicking Carry Forward")))
 
Upvote 0
The Worksheet_Change event procedure does not trigger on a formula calculation. It triggers on a manual change to the worksheet. One possible way around that is to trigger off of the cells in the formula that the user changes manually, but test the result of the formula e.g. if the user changes J3 or J4 then test the result in G1.

Rich (BB code):
    If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then
        If Range("G1").Value = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" Then Call TalkDistilled
   
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
 
Upvote 0
The Worksheet_Change event procedure does not trigger on a formula calculation. It triggers on a manual change to the worksheet. One possible way around that is to trigger off of the cells in the formula that the user changes manually, but test the result of the formula e.g. if the user changes J3 or J4 then test the result in G1.

Rich (BB code):
    If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then
        If Range("G1").Value = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" Then Call TalkDistilled
  
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
Thanks. Yes I see what you mean now. Unfortunately, the above adjustment has stopped it working. I orignally had this working as a Worksheet_Calculation event procedure by having a dummy calculation in hidden cells i.e
Excel Formula:
=J3*1
but had to remove it due to constant cycling and repeating. This is because there are multiple triggers which tell the user if a wrong number is entered and the output is out of range. They would then fix it and move on. But with the water, the high number is not an error but a real life high consumption and therefore the value has to remain. The original solutuon will fire when the G1 cell is selected after the high number is entered into J3 or J4 even with the formula, but has to be the user selecting G1.
 
Upvote 0
The Worksheet_Change event procedure does not trigger on a formula calculation. It triggers on a manual change to the worksheet. One possible way around that is to trigger off of the cells in the formula that the user changes manually, but test the result of the formula e.g. if the user changes J3 or J4 then test the result in G1.
Rich (BB code):
 If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then If Range("G1").Value = "Distilled Water Consumption is High. Please Give a Reason in the Message Box" Then Call TalkDistilled ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then

If by entering any number into J3 or J4 it could trigger the following:

Excel Formula:
 Range("G1").Select
    Selection.FormulaR1C1 = _
        "=IF(AND(R3C10>15,R4C10<16),""Distilled Water Consumption is High. Please Give a Reason in the Message Box"",IF(AND(R4C10>15,R3C10<16),""Domestic Water Consumption is High. Please Give a Reason in the Message Box"",IF(AND(R3C10>15,R4C10>15),""Domestic & Distilled Water Consumption is High. Please Give a Reason in the Message Box"",""Previous Day's ROBs Will Update Af" & _
        "ter Clicking Carry Forward"")))" & _
        ""

then I think it could work. Because it would be selecting G1 and pressing control enter to run the formula.
 
Upvote 0
I don't really understand what that meant.


You could also just test the values of J3 and J4 in the VBA code.

Rich (BB code):
    If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then
        If Range("J3").Value > 15 And  Range("J4").Value <16 Then Call TalkDistilled
   
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
 
Upvote 0
Solution
Lol, thanks.
I don't really understand what that meant.


You could also just test the values of J3 and J4 in the VBA code.

Rich (BB code):
    If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then
        If Range("J3").Value > 15 And  Range("J4").Value <16 Then Call TalkDistilled
  
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
Yes, that works. A far simpler solution.
Many thanks for your help, very kind of you to take the time :)
 
Upvote 0

Forum statistics

Threads
1,214,924
Messages
6,122,294
Members
449,077
Latest member
Rkmenon

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