VBA Code to Enter a String Text when the trigger cell's value meets certain conditions

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows
Hi all,

I would like code to automatically generate text in a cell when another cell's value meets the preset conditions. I may also want to add a message box too.
So for example:
Trigger Cell = H6 if Value of H6<0 or H6>200 to populate merged cells "H13:K14" with text "Warning! Please Check the LSFO Meter Readings"
To also add a message box to the same effect (I can remove later if this is too annoying).
Once the error condition is no longer met, i.e. the value of H6 is between 0 to 200, for the populated merged cell "H13:K14" to have it's contents cleared.

I also have other trigger cells, where the warning message would be slightly different, but would it be just a case of repeating a small section of the code within the same macro or would I have to make multiple macros for each trigger cell?

Thanks
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows
I must also add, I already have other Private Sub Worksheet_Change (ByVal Target as Range) code, so it would need to be added.
 

bebo021999

Well-known Member
Joined
Jul 14, 2011
Messages
1,142
Office Version
  1. 2016
For only one trigger cell H6 (with comment within code, it's for 2nd trigger cell):
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ce1 As Range, msg1 As String
Set ce1 = Range("H6"): msg1 = "Warning! Please Check the LSFO Meter Readings"
' dupplicate ce1 for ce2, if you have another trigger cell L6
'dim ce2 As Range, msg2 As String
' Set ce2 = Range("L6"): msg2 = "Warning something else here!"
    With Range("H13:K14")
        If Not Intersect(Target, ce1) Is Nothing Then
            Select Case ce1.Value
                Case 0 To 200
                    .ClearContents
                Case Else
                    .Value = msg1
                    MsgBox msg1
            End Select
        End If
    End With
    
'duplicate with...end with block for 2nd trigger cell
'With Range("H15:K16")
   '     If Not Intersect(Target, ce2) Is Nothing Then
    '        Select Case ce2.Value
     '           Case 0 To 200
      '              .ClearContents
       '         Case Else
        '            .Value = msg2
             '       MsgBox msg2
      '      End Select
       ' End If
'    End With
End Sub
 

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows
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)
Case "ROP"
Set cmtCell = Range("D23")
Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
Case "SOP2"
Set cmtCell = Range("D25")
Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
Case "ROP2"
Set cmtCell = Range("D26")
Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
Case Else
' Comment already deleted as initialisation step
End Select

Range("j13").Select

Application.EnableEvents = True
End If
End If

End Sub
Hi, many thanks for your reply and solution. My only question now is, how would I incorporate this into my present code:

It's as follows:
 

bebo021999

Well-known Member
Joined
Jul 14, 2011
Messages
1,142
Office Version
  1. 2016

ADVERTISEMENT

What is your code so far?
 

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows
What is your code so far?
well i haven't yet tried pasting your code into mine as I don't want to mess up the first code. As you can see from it (I tried to paste it earlier but maybe not very clear) it's quite involving using trigger cells and adding / removing comments from other cells (it calls another macro (Private Sub AddAndFmtComment(rCell As Range, RegType As String)) for the comments
 

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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)
                Case "ROP"
                    Set cmtCell = Range("D23")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                Case "SOP2"
                    Set cmtCell = Range("D25")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                Case "ROP2"
                    Set cmtCell = Range("D26")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                Case Else
                 ' Comment already deleted as initialisation step
            End Select
                         
            Range("j13").Select
            
            Application.EnableEvents = True
        End If
    End If

End Sub
 

bebo021999

Well-known Member
Joined
Jul 14, 2011
Messages
1,142
Office Version
  1. 2016
Put below code at the end of your current code, righ before "end sub"

VBA Code:
Dim ce1 As Range, msg1 As String
Set ce1 = Range("H6"): msg1 = "Warning! Please Check the LSFO Meter Readings"
    With Range("H13:K14")
        If Not Intersect(Target, ce1) Is Nothing Then
            Select Case ce1.Value
                Case 0 To 200
                    .ClearContents
                Case Else
                    .Value = msg1
                    MsgBox msg1
            End Select
        End If
    End With
 
Solution

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows
Dim ce1 As Range, msg1 As String Set ce1 = Range("H6"): msg1 = "Warning! Please Check the LSFO Meter Readings" With Range("H13:K14") If Not Intersect(Target, ce1) Is Nothing Then Select Case ce1.Value Case 0 To 200 .ClearContents Case Else .Value = msg1 MsgBox msg1 End Select End If End With
Thanks. I have tried that, but it doesn't seem to be triggering at all. When I put a crazy meter reading in to generate a negative number or number above 200 I am not getting the warning message
 

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
67
Office Version
  1. 2013
Platform
  1. Windows
Put below code at the end of your current code, righ before "end sub"

VBA Code:
Dim ce1 As Range, msg1 As String
Set ce1 = Range("H6"): msg1 = "Warning! Please Check the LSFO Meter Readings"
    With Range("H13:K14")
        If Not Intersect(Target, ce1) Is Nothing Then
            Select Case ce1.Value
                Case 0 To 200
                    .ClearContents
                Case Else
                    .Value = msg1
                    MsgBox msg1
            End Select
        End If
    End With
It is appearing like this:

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)
                Case "ROP"
                    Set cmtCell = Range("D23")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                Case "SOP2"
                    Set cmtCell = Range("D25")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                Case "ROP2"
                    Set cmtCell = Range("D26")
                    Call AddAndFmtComment(rCell:=cmtCell, RegType:=Target.Value)
                Case Else
                 ' Comment already deleted as initialisation step
            End Select
                         
            Range("j13").Select
            
            Application.EnableEvents = True
        End If
    End If
    
Dim ce1 As Range, msg1 As String
Set ce1 = Range("H6"): msg1 = "Warning! Please Check the LSFO Meter Readings"
    With Range("H13:K14")
        If Not Intersect(Target, ce1) Is Nothing Then
            Select Case ce1.Value
                Case 0 To 200
                    .ClearContents
                Case Else
                    .Value = msg1
                    MsgBox msg1
            End Select
        End If
    End With
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,282
Messages
5,836,388
Members
430,425
Latest member
xlsee

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
Top