If cell contains specific test then present a message

M

MLC1980

New Member
Joined
Oct 1, 2024
Messages
13
Office Version
  1. 2016
Platform
  1. Windows
Hi, can anyone help me with the following?

I have a spreadsheet where if the text equals either "AV_EXC" or "AV_INC" or "ADJ_EXC" or "ADJ_INC" in cell range C39:D64 then I want the following message to appear "Enhanced SPL is only available for weeks 1 to 26, please check the dates".

Just for completeness, I already have the following code applied to the worksheet for some other actions

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("I11") < Range("Z34") Then
        MsgBox "There are not enough Enhanced SPL weeks available for Parent 2, please check your calculations"
    End If
 If Range("P21") < Range("I30") Then
        MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations"
    End If
If Range("P23") < Range("I32") Then
        MsgBox "There are not enough 'Statutory Pay Only' weeks available for Parent 2, please check your calculations"
    End If
If Range("P24") < Range("I33") Then
        MsgBox "There are not enough Unpaid SPL weeks available for Parent 2, please check your calculations"
    End If

End Sub

Thanks in adavnce
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
Hello @MLC1980. Try next updated code:
VBA Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Range("I11") < Range("Z34") Then
        MsgBox "There are not enough Enhanced SPL weeks available for Parent 2, please check your calculations"
    End If

    If Range("P21") < Range("I30") Then
        MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations"
    End If

    If Range("P23") < Range("I32") Then
        MsgBox "There are not enough 'Statutory Pay Only' weeks available for Parent 2, please check your calculations"
    End If

    If Range("P24") < Range("I33") Then
        MsgBox "There are not enough Unpaid SPL weeks available for Parent 2, please check your calculations"
    End If

    ' New condition for checking text in C39:D64
    Dim cell        As Range

    For Each cell In Range("C39:D64")

        If cell.Value = "AV_EXC" Or cell.Value = "AV_INC" Or cell.Value = "ADJ_EXC" Or cell.Value = "ADJ_INC" Then
            MsgBox "Enhanced SPL is only available for weeks 1 to 26, please check the dates! ", vbCritical
            Exit For
        End If

    Next cell

End Sub
Good luck.
 
Upvote 0
Solution
Hi @MikeVol

The code that you have added in works perfectly but the original code now isn't working, any ideas?
 
Upvote 0
@MLC1980. I just supplemented your code! Look at your side. Try closing the book and opening it again.
 
Upvote 0
MLC1980 said:
Hi, can anyone help me with the following?

I have a spreadsheet where if the text equals either "AV_EXC" or "AV_INC" or "ADJ_EXC" or "ADJ_INC" in cell range C39:D64 then I want the following message to appear "Enhanced SPL is only available for weeks 1 to 26, please check the dates".

Just for completeness, I already have the following code applied to the worksheet for some other actions

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("I11") < Range("Z34") Then
        MsgBox "There are not enough Enhanced SPL weeks available for Parent 2, please check your calculations"
    End If
 If Range("P21") < Range("I30") Then
        MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations"
    End If
If Range("P23") < Range("I32") Then
        MsgBox "There are not enough 'Statutory Pay Only' weeks available for Parent 2, please check your calculations"
    End If
If Range("P24") < Range("I33") Then
        MsgBox "There are not enough Unpaid SPL weeks available for Parent 2, please check your calculations"
    End If

End Sub

Thanks in adavnce
Click to expand...
Your code allows an invalid entry to remain in the cell.

This code will revert to the previous value.

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

  If target.CountLarge > 1 Then
    Exit Sub
  End If
    
  If Not Intersect(target, Range("C39:D64")) Is Nothing And InStr(1, "AV_EXC,AV_INC,ADJ_EXC,ADJ_INC", target.Value, vbTextCompare) > 0 Then
    
    MsgBox "Enhanced SPL is only available for weeks 1 to 26, please check the dates.", vbOKOnly, "Warning"
  
    Call subRevertValue(target)
    
    Exit Sub
  
  End If
  
  If Not Intersect(target, Range("I11,Z34")) Is Nothing And Range("I11") < Range("Z34") Then
    MsgBox "There are not enough Enhanced SPL weeks available for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
  
  If Not Intersect(target, Range("P21,I30")) Is Nothing And Range("P21") < Range("I30") Then
    MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
  
  If Not Intersect(target, Range("P23,I32")) Is Nothing And Range("P23") < Range("I32") Then
    MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
  
  If Not Intersect(target, Range("P24,I33")) Is Nothing And Range("P24") < Range("I33") Then
    MsgBox "There are not enough Unpaid SPL weeks available for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
  
End Sub

Private Sub subRevertValue(target As Range)

  Application.EnableEvents = False
  target.Value = varLastValue
  Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal target As Range)

  varLastValue = target.Value
  
End Sub
 
Upvote 0
HighAndWilder said:
Your code allows an invalid entry to remain in the cell.

This code will revert to the previous value.

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

  If target.CountLarge > 1 Then
    Exit Sub
  End If
  
  If Not Intersect(target, Range("C39:D64")) Is Nothing And InStr(1, "AV_EXC,AV_INC,ADJ_EXC,ADJ_INC", target.Value, vbTextCompare) > 0 Then
  
    MsgBox "Enhanced SPL is only available for weeks 1 to 26, please check the dates.", vbOKOnly, "Warning"
 
    Call subRevertValue(target)
  
    Exit Sub
 
  End If
 
  If Not Intersect(target, Range("I11,Z34")) Is Nothing And Range("I11") < Range("Z34") Then
    MsgBox "There are not enough Enhanced SPL weeks available for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
 
  If Not Intersect(target, Range("P21,I30")) Is Nothing And Range("P21") < Range("I30") Then
    MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
 
  If Not Intersect(target, Range("P23,I32")) Is Nothing And Range("P23") < Range("I32") Then
    MsgBox "There is not enough Statutory Pay available for all of the Enhanced SPL weeks for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
 
  If Not Intersect(target, Range("P24,I33")) Is Nothing And Range("P24") < Range("I33") Then
    MsgBox "There are not enough Unpaid SPL weeks available for Parent 2, please check your calculations.", vbOKOnly, "Warning!"
    Call subRevertValue(target)
    Exit Sub
  End If
 
End Sub

Private Sub subRevertValue(target As Range)

  Application.EnableEvents = False
  target.Value = varLastValue
  Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal target As Range)

  varLastValue = target.Value
 
End Sub
Click to expand...
@HighAndWilder thanks for your solution, I tried it and I do like the idea of the invalid entry being removed from the cell, however, the problem I had was there was also some formatting applied to the cell (a fill colour) and that formatting didn't get removed. If I was removing the invalid entry I would also want the fill colour to be removed. Is that possible?
 
Upvote 0
MLC1980 said:
@HighAndWilder thanks for your solution, I tried it and I do like the idea of the invalid entry being removed from the cell, however, the problem I had was there was also some formatting applied to the cell (a fill colour) and that formatting didn't get removed. If I was removing the invalid entry I would also want the fill colour to be removed. Is that possible?
Click to expand...

It is always good to correct invalid data entry when it is first entered.

I assume that you want 'No Fill' as if you selected it on this menu.

1729608372761.png


Replace the subRevertValue procedure that you already have with this one below.

VBA Code: 
Private Sub subRevertValue(target As Range)

  Application.EnableEvents = False
  With target
    .Value = varLastValue
    ' Remove Any Fill Colors From Target Cell.
    .Interior.Color = xlNone
  End With
  Application.EnableEvents = True

End Sub
 
Upvote 0
HighAndWilder said:
It is always good to correct invalid data entry when it is first entered.

I assume that you want 'No Fill' as if you selected it on this menu.

View attachment 118372

Replace the subRevertValue procedure that you already have with this one below.

VBA Code: 
Private Sub subRevertValue(target As Range)

  Application.EnableEvents = False
  With target
    .Value = varLastValue
    ' Remove Any Fill Colors From Target Cell.
    .Interior.Color = xlNone
  End With
  Application.EnableEvents = True

End Sub
Click to expand...
That's great thank you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

4
  • Question Question
VBA - Dynamic Cell Shifting
Replies
4
Views
2K
4EverStudent
4
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
A
  • Solved
Calendar issue
Replies
1
Views
2K
AndyEd
A
P
  • Question Question
Freeze on specific sheet during macro execution and loop through each sheets containing a specific name
Replies
5
Views
929
BSALV
BSALV
gheyman
  • Solved
Contain a value from a cell within a MsgBox
Replies
2
Views
469
gheyman
gheyman

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