Help with my Worksheet_change code

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
141
Office Version
  1. 2013
Platform
  1. Windows
Hi. I need help with to expand my worksheet_change code.
I have multiple worksheet_change triggers and actions but just can't figure out how to do the following.
I have a range ("M4:M53") which is already detecting certain case words that are the lowest non-empty cell in the range and triggering various macros which including talking and adding and removing comments. These work all fine. I need these case words to now be a condition which when met will fire a macro to copy and paste the contents of cell C4 to another cell when C4 has been changed. I already have the child macros prepared and ready to be called. The case words are "SOP", "ROP", "SOP2" and "ROP2". These are already being used as triggers. The trigger cell is C4. The action is copy C4 into another cell (Macro ready for this).
So for example with "SOP":
When "SOP" matches the last non-empty cell in range.("M4:M53") and when a number is entered into C4 to then fire another macro called CopyMTCtratSOP. The macro CopyMTCtratSOP should fire again if Cell C4 is altered (for example if they have entered a wrong number in). It should then never fire again once SOP is no longer the lowest non empty cell in the range. I have data validation in the cells of M4:M53 so only these cases can be selected. There should only be one "SOP", "ROP", "SOP2" and "ROP2" selected in the entire range and I haven't yet found a way to stop a 2nd SOP being selected by mistake (which would screw it up) but that's another problem for another day. Here is my current code, I think it can be added quite easily. Lots of it you can ignore. I was able to do the above with FAOP as this is always in M3 and I did it by testing whether the cell M4 is empty to fire similar macro.
Thanks
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Oops here is the code:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lrow As Integer
   
   'This gives warning if water consumption is high and tells user to give a reason.
    If Not Application.Intersect(Range("J3:J4"), Target) Is Nothing Then
        If Range("J3").Value > 15 And Range("J4").Value < 16 Then Call TalkDistilled
        If Range("J4").Value > 15 And Range("J3").Value < 16 Then Call TalkDomestic
        If Range("J3").Value > 15 And Range("J4").Value > 15 Then Call TalkDomDistHigh
                   
    ElseIf Not Application.Intersect(Range("M4:M53"), Target) Is Nothing Then
    
  'Clears some cells when the various cases are detected ie "NOON in PORT", "NOON in TRANS", "ROP", "ROP2"
        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
                     
           'Calls comment macros when the below cases are detected.
           
            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
    
    'Speaks the duty eng name
    If Not Application.Intersect(Range("H12"), Target) Is Nothing Then
        If Range("H12").Value = "2nd Eng" Then Call Talk2E
        If Range("H12").Value = "3rd Eng" Then Call Talk3E
        If Range("H12").Value = "4th Eng" Then Call Talk4E
        If Range("H12").Value = "5th Eng" Then Call Talk5E
        If Range("H12").Value = "x-2/E" Then Call TalkX2E
        If Range("H12").Value = "x-3/E" Then Call TalkX3E
        If Range("H12").Value = "x-4/E" Then Call TalkX4E
    End If

    'ER temperature plus warning if hot
    If Not Application.Intersect(Range("E14"), Target) Is Nothing Then
        If Range("E14").Value <= 41 And Range("E14") > 0 Then Call ERtemp
        If Range("E14").Value > 41 Then Call ERtempWarning
                
     End If
    'Fuel Select
    If Not Application.Intersect(Range("J17"), Target) Is Nothing Then
        If Range("J17").Value = "LSFO" Then Call TalkLSFO
        If Range("J17").Value = "LSMGO" Then Call TalkLSMGO
     End If
    
    'Daily sludge
    If Not Application.Intersect(Range("I10"), Target) Is Nothing Then Call TalkSludgeLog
    
    'Detects FAOP and copies M/T counter to E7 when a change is detected in C4 and only when M4 is empty (i.e. at FAOP)
    Dim cell8 As Range
    Set cell8 = Range("M4")
    
    If Not Application.Intersect(Range("C4"), Target) Is Nothing Then
        If IsEmpty(cell8) Then Call CopyMTCtratFAOP
    End If
         
End Sub
 
Upvote 0
I wasn't able to workout how to test the last value in the column range using VBA. I was doing something along the lines of
VBA Code:
dim lastcell = string
lastcell = Cells(Rows.Count, "M").End(xlUp).Row
 If Not Application.Intersect(Range("C4"), Target) Is Nothing Then
If lastcell.value = "SOP" Then Call CopyMTCtratSOP
End If

However this didn't work. Tried various workarounds but just got confused. I have kind of cheated by using Excel formula
Excel Formula:
=LOOKUP(2,1/($M$3:$M$53<>""),$M$3:$M$53)
in a hidden cell. Then I used this code

VBA Code:
 Dim cell8 As Range
    Dim cell9 As Range
    Set cell8 = Range("M4")
    Set cell9 = Range("I24")
    
    If Not Application.Intersect(Range("C4"), Target) Is Nothing Then
        If IsEmpty(cell8) Then Call CopyMTCtratFAOP
        If cell9.Value = "SOP" Then Call CopyMTCtratSOP
        If cell9.Value = "ROP" Then Call CopyMTCtratROP
        If cell9.Value = "SOP2" Then Call CopyMTCtratSOP2
        If cell9.Value = "ROP2" Then Call CopyMTCtratROP2
    End If

Not pretty or elegant, but it's working.
 
Upvote 0
Solution

Forum statistics

Threads
1,214,617
Messages
6,120,541
Members
448,970
Latest member
kennimack

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