If cell contains specific test then present a message

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

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
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
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
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
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
@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
@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?

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
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
That's great thank you!
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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