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

 

[Artik]

Just in case, in the Immediate window, type:

Application.EnableEvents = True

and press Enter. Now try if the code works.

Artik

 

[Mattl1976]

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

OK so the code works on a blank workbook when I type in the Rubber .25 however in my main spreadhseet the rubber .25 fills in column B as a result of an Xlookup. Does this make a difference?

 

[Mattl1976]

Just in case, in the Immediate window, type:

Application.EnableEvents = True

and press Enter. Now try if the code works.

Artik

sorry what do you mean by in the immediate window? where would i type this?

 

[Cubist]

OK so the code works on a blank workbook when I type in the Rubber .25 however in my main spreadhseet the rubber .25 fills in column B as a result of an Xlookup. Does this make a difference?

Yes, there's a difference in how the code is triggered. With WorksheetChange, it's only triggered on manual change. For formula, you'd need WorksheetCalculate.

Private Sub Worksheet_Calculate()
    Dim r As Range
    
    On Error GoTo Cleanup
    Application.EnableEvents = False
    
    For Each r In Me.Columns("B").Cells
        If InStr(1, r.Value, "rubber .25", vbTextCompare) > 0 Then
            MsgBox "don't use rubber hose"
        End If
    Next r

Cleanup:
    Application.EnableEvents = True
End Sub

 

[Mattl1976]

Yes, there's a difference in how the code is triggered. With WorksheetChange, it's only triggered on manual change. For formula, you'd need WorksheetCalculate.

Private Sub Worksheet_Calculate()
    Dim r As Range
   
    On Error GoTo Cleanup
    Application.EnableEvents = False
   
    For Each r In Me.Columns("B").Cells
        If InStr(1, r.Value, "rubber .25", vbTextCompare) > 0 Then
            MsgBox "don't use rubber hose"
        End If
    Next r

Cleanup:
    Application.EnableEvents = True
End Sub

ok so do I put this as a new code or in the middle of the original code you wrote above?

 

[Cubist]

Break it up like this.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
   
    On Error GoTo Cleanup
    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

Cleanup:
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate()
    Dim r As Range
    Dim lastRow As Long
    
    On Error GoTo Cleanup
    Application.EnableEvents = False
    
    ' Find the last used row in column B
    lastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
    
    ' Loop through each cell in column B up to the last used row
    For Each r In Me.Range("B1:B" & lastRow)
        If InStr(1, r.Value, "rubber .25", vbTextCompare) > 0 Then
            MsgBox "don't use rubber hose"
        End If
    Next r

Cleanup:
    Application.EnableEvents = True
End Sub

 

[Mattl1976]

Break it up like this.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
  
    On Error GoTo Cleanup
    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

Cleanup:
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Calculate()
    Dim r As Range
    Dim lastRow As Long
   
    On Error GoTo Cleanup
    Application.EnableEvents = False
   
    ' Find the last used row in column B
    lastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
   
    ' Loop through each cell in column B up to the last used row
    For Each r In Me.Range("B1:B" & lastRow)
        If InStr(1, r.Value, "rubber .25", vbTextCompare) > 0 Then
            MsgBox "don't use rubber hose"
        End If
    Next r

Cleanup:
    Application.EnableEvents = True
End Sub

I copied and uploaded as the above.

As per below the 10804 and 2001708 pop ups work byt the top line does not pick up the rubber .25 pop up.

 

[Cubist]

It works fine for me when I change the value in A1 from 2 to 1. Again, test on blank workbook.

Book1
	A	B	C	D	E	F
1	1	hose and rubber .25		1	hose and rubber .25
2				2	nothing
3
4
Master

Cell Formulas
Range	Formula
B1	B1	=XLOOKUP(A1,D1:D2,E1:E2)

 

[Mattl1976]

Ok I dont know what else to try now, it works in a blank document just not in my main spreadsheet.

 

[Cubist]

Try running this macro first then test again.

Sub t()
    Application.EnableEvents = True
End Sub

If it still doesn't work I don't know why. You might need to upload your sheet onto a DropBox and upload it here.