MsgBox to list row numbers when rows with criteria is met


Hello Experts,

I am new to excel VBA and hope someone could help me creating a popup message when a condition is met moving from one row to next and then list in the Message box all the rows where condition is met.

Below condition is if sum of Cell(A1)+Cell(B1)<>Cell(C1) then put the row number in message popup box, this should move through each row and check and then finally list all rows in the message box. In Below box It would show in message box

[Row 1 is incorrect

Row 3 is incorrect]

I hope I have made it simple to understand what I want to achieve. I really appreciate any help here, Thanks.

DATA      ColumnA     ColumnB     ColumnC

Row1           5                  4                  7

Row2           4                  4                  8

Row3           3                  2                  7



Selected Answer

This is the code that does all the work. You find it in the code module Manager in the attached workbook.

Option Explicit
' Modifying the enumerations below enables creation of one or more
' caption rows above the first row to be examined.
' Similarly, the columns with the criteria and the check total
' can be placed anywhere in the sheet.
Enum Nws                                ' worksheet navigation
    NwsFirstDataRow = 2
    NwsCrit1 = 2                        ' column 2 = column B
    NwsCrit2                            ' not specified means: previous + 1 (here 2 + 1 = 3)
    NwsCheck = 6
End Enum

Sub CheckEntries()
    ' 25 Aug 2018
    Dim Fun() As String
    Dim i As Long
    Dim R As Long, Rl As Long
    Dim Check As Double
    With Worksheets("Test Sheet")           ' change the sheet name as you wish
        ' look for the last entry in column NwsCheck
        Rl = .Cells(.Rows.Count, NwsCheck).End(xlUp).Row
        ReDim Fun(Rl)
        For R = NwsFirstDataRow To Rl
            Check = Val(.Cells(R, NwsCrit1).Value) + Val(.Cells(R, NwsCrit2).Value)
            If Check <> Val(.Cells(R, NwsCheck).Value) Then
                i = i + 1
                Fun(i) = String(6, " ") & "- Row " & CStr(R)
            End If
        Next R
    End With
    If i Then
        Fun(0) = "Discrepancies were found in the" & vbCr & _
                 "following " & IIf(i = 1, "row.", CStr(i) & " rows.")
        Fun(0) = "No discrepancies were found."
    End If
    ReDim Preserve Fun(i)
    MsgBox Join(Fun, Chr(13))
End Sub

Observe that the macro finds the last data row by looking at the Check column. If either of the two criteria columns has data at the end of the list and the Check column is blank the discrepancy will not be listed. If you can't make sure that the last row in the Check column has a value in it (even 0 will do) then let the code find the last row to be examined from one of the criteria columns.



This is exactly what I was lookimg for. Thank you Variatus. 
Sharucd (rep: 2) Aug 25, '18 at 10:07 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login