VBA Code MsgBox if 2 criteria for each row in table

Question

I have a code that looks up 2 different cells and displays a pop up every time both cells have certain criteria, however it only does it for that specific row.

I'm looking for a way to have 1 code that will look up every pair of cells on each row and evaluate them independently.

Tried changing the ranges but obviously that creates a long code, I'm sure there is a better way but my knowledge is limited.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("A:B")) Is Nothing Then
         If (Range("A2").Value = "Text1") And Range("B2").Value > ### Then MsgBox "Message"

End If

End Sub

The code should look at the entire table of 200 rows and ideally keep looking if the table grows larger for specific criteria on each row, all A2 and B2, A3 and B3 and so on. Currently it only looks at the cells I selected and the only solution I can think of is to copy paste and change the ranges on each new piece of the code.

Thank you!

`If Range("A" & Target.Row).Value = "Text1" And Range("B" & Target.ROW).Value > ### Then MsgBox "Message"` ` — Siddharth Rout, Jan 08 '19 at 02:57
Also you may want to use `Target.Cells.CountLarge` instead of `.Count`? Please see [This](https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640) — Siddharth Rout, Jan 08 '19 at 02:58
What you describe needs a For ... Next loop. Look it up at MSDN or where they teach. Logically that doesn't make sense in a Change event, however, because only one item was changed at a time and you don't need to check those that weren't changed because they have been checked before. To create a dynamic range look at Cells(Rows.Count, "A").End(xlUp).Row — Variatus, Jan 08 '19 at 03:03
@Variatus: When you paste on multiple cells in the relevant range then the change happens in those as well. But the `Target.Cells.CountLarge/Target.Cells.Count` will negate it. — Siddharth Rout, Jan 08 '19 at 03:05
@SiddharthRout, that was perfect! thank you so much! you fixed my problem sir. — IttookJohnLee, Jan 08 '19 at 03:10

score 0 · Answer 1 · answered Jan 22 '19 at 10:09

Simply loop over columns A and B:

Option Explicit
Sub LookUpWithMessageBox()
    Dim lastRow As Long, i As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastRow
        If Cells(i, 1).Value = "column A criteria" And Cells(i, 2).Value = "column B criteria" Then MsgBox Cells(i, 1).Value & " " & Cells(i, 2).Value
    Next
End Sub

score 0 · Answer 2 · answered Jan 22 '19 at 11:09

You can try this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngTable As Range
    Dim Lastrow As Long

    With ActiveSheet
        'Calculate table last row
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Set rng to search (FROM Column A row 2 TO Column B row 5)
        Set rngTable = .Range(Cells(2, 1), Cells(Lastrow, 2))
        'Check if tha target included in the table
        If Not Intersect(Target, rngTable) Is Nothing Then
            'Check if the target and the cell next to it are equal
            If Target.Value = Target.Offset(0, -1).Value Then
                'if both cells are equal meesage with there address will appear
                MsgBox "Cells " & Replace(Target.Offset(0, -1).Address, "$", "") & " and " & Replace(Target.Address, "$", "") & " are the same!"
            End If

        End If
    End With

End Sub

Sheet structure:

VBA Code MsgBox if 2 criteria for each row in table

2 Answers2