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

JohnGow383

JohnGow383

Board Regular
Joined
Jul 6, 2021
Messages
141
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

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
I must also add, I already have other Private Sub Worksheet_Change (ByVal Target as Range) code, so it would need to be added.
 
Upvote 0
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
 
Upvote 0
bebo021999 said:
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
Click to expand...
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:
 
Upvote 0
bebo021999 said:
What is your code so far?
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Solution
bebo021999 said:
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
Click to expand...
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
 
Upvote 0
bebo021999 said:
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
Click to expand...
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
Trouble pre-setting userform values based off user input
Replies
2
Views
62
gc2001
G
JohnGow383
  • Solved
VBA code to add Constraints to my Worksheets_Calculate Macro
Replies
7
Views
458
JoeMo
J
G
  • Question
Get VBA to automatically generate an email when a cell meets a date condition
Replies
3
Views
175
Logit
Logit
K
  • Question
Conditional Formatting cells that contain matching strings of text
Replies
1
Views
805
ksjohnson86
K
T
  • Solved
Removing Left Text from a Cell with condition VBA
Replies
3
Views
198
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,430
Messages
6,119,442
Members
448,898
Latest member
drewmorgan128

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