VBA pop up using multiple ranges/rows

[Mattl1976]

Hi I am currently using vba for a pop up message from column A depending on whether a certain value is shown as per below.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, r As Range
Set A = Range("A:A")
If Intersect(Target, A) Is Nothing Then Exit Sub
For Each r In Target
If r.Value = "2001708" Then
MsgBox "2 required per pump "
ElseIf r.Value = "10804" Then
MsgBox "use 2001708 for 220v pumps "
End If
Next r
End Sub


My question is how do I add another pop up if column B contains the text "rubber .25" with the pop up message saying "dont use rubber hose"

Thanks

 

[Cubist]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
        For Each r In Intersect(Target, Me.Columns("A"))
            Select Case r.Value
                Case "2001708"
                    MsgBox "2 required per pump"
                Case "10804"
                    MsgBox "use 2001708 for 220v pumps"
            End Select
        Next r
    End If
    
    If Not Intersect(Target, Me.Columns("B")) Is Nothing Then
        For Each r In Intersect(Target, Me.Columns("B"))
            If InStr(1, r.Value, "rubber .25", vbTextCompare) > 0 Then
                MsgBox "dont use rubber hose"
            End If
        Next r
    End If

    Application.EnableEvents = True
End Sub

 

[Mattl1976]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
   
    Application.EnableEvents = False
   
    If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
        For Each r In Intersect(Target, Me.Columns("A"))
            Select Case r.Value
                Case "2001708"
                    MsgBox "2 required per pump"
                Case "10804"
                    MsgBox "use 2001708 for 220v pumps"
            End Select
        Next r
    End If
   
    If Not Intersect(Target, Me.Columns("B")) Is Nothing Then
        For Each r In Intersect(Target, Me.Columns("B"))
            If InStr(1, r.Value, "rubber .25", vbTextCompare) > 0 Then
                MsgBox "dont use rubber hose"
            End If
        Next r
    End If

    Application.EnableEvents = True
End Sub

Hey thanks for sending through, unfortunately the second msg box for the rubber hose did not work. Still worked for the top section in the column A just not for the column B. For column B the rubber . 25 is just part of the text in the cell. Not sure if that makes a difference?

 

[Cubist]

For column B the rubber . 25 is just part of the text in the cell. Not sure if that makes a difference?

I suspected that was the case so I used the InStr() method. It's working on my end. Check if you place the code in the right sheet module.

 

[Mattl1976]

yes it is in the correct column 'B'.

 

[Cubist]

I'm saying to check where you placed the code. It should be in your sheet module and not ThisWorkBook or the general module. Right-click on the sheet name -> View Code -> Paste in the code in the editor.

 

[Mattl1976]

I'm saying to check where you placed the code. It should be in your sheet module and not ThisWorkBook or the general module. Right-click on the sheet name -> View Code -> Paste in the code in the editor.
View attachment 111638

Oh yes understand it is in the correct place.

 

[Cubist]

hm... You have a lot of workbooks open. Make sure it's the right workbook as well.

 

[Mattl1976]

hm... You have a lot of workbooks open. Make sure it's the right workbook as well.

yes it is the correct workbook and worksheet.

 

[Cubist]

Test the code out on a blank workbook. Does that work?