Need help in event

[online]

Hi expert,

I have create a file for user in which some field are mandatory when column A is filled. I have written a event whenever user save file a pop up msg will show to filled mandatory fields.
It's working only a single sheet when i add more sheet it's not showing accurate. Please see below code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Long
Dim Lr As Long
Dim msg As String
Dim sht As Worksheet
Lr = Cells(Cells.Rows.Count, 1).End(xlUp).Row
With Worksheets("Profiling")
    For i = 1 To Lr
        If .Cells(i, "A").Value <> "" Then
            If .Cells(i, "B").Value = "" Then
                msg = msg & "Cell " & vbTab & "Profiling" & .Cells(i, "B").Address & vbNewLine
            End If
            If .Cells(i, "C").Value = "" Then
                msg = msg & "Cell " & vbTab & "Profiling" & .Cells(i, "C").Address & vbNewLine
            End If
            If .Cells(i, "D").Value = "" Then
                msg = msg & "Cell " & vbTab & "Profiling" & .Cells(i, "D").Address & vbNewLine
            End If
            If .Cells(i, "E").Value = "" Then
                msg = msg & "Cell " & vbTab & "Profiling" & .Cells(i, "E").Address & vbNewLine
            End If
            If .Cells(i, "N").Value = "" Then
                msg = msg & "Cell " & vbTab & "Profiling" & .Cells(i, "O").Address & vbNewLine
            End If
            If .Cells(i, "O").Value = "" Then
                msg = msg & "Cell " & vbTab & "Profiling" & .Cells(i, "O").Address & vbNewLine
            End If
        End If
    Next i
    If msg = "" Then
        Exit Sub
    Else
        .Activate
        MsgBox "Please fill in these cells and then save: " & vbNewLine & vbNewLine & msg
        Cancel = True
    End If
End With
With Worksheets("DAR")
    For i = 1 To Lr
        If .Cells(i, "A").Value <> "" Then
            If .Cells(i, "B").Value = "" Then
                msg = msg & "Cell " & vbTab & "DAR" & .Cells(i, "B").Address & vbNewLine
            End If
            If .Cells(i, "C").Value = "" Then
                msg = msg & "Cell " & vbTab & "DAR" & .Cells(i, "C").Address & vbNewLine
            End If
            If .Cells(i, "D").Value = "" Then
                msg = msg & "Cell " & vbTab & "DAR" & .Cells(i, "D").Address & vbNewLine
            End If
            If .Cells(i, "E").Value = "" Then
                msg = msg & "Cell " & vbTab & "DAR" & .Cells(i, "E").Address & vbNewLine
            End If
        End If
    Next i
    If msg = "" Then
        Exit Sub
    Else
        .Activate
        MsgBox "Please fill in these cells and then save: " & vbNewLine & vbNewLine & msg
        Cancel = True
    End If
End With
End Sub

Thanks for your contributions I appreciate it

[JKwan]

Just by glancing over your code, your EXIT SUB will exit the subroutine when the user fullful the requirements!

[CatDaddy]

you also dont reset the last row, in case its different on the second sheet?

[online]

Hi CatDaddy,

I dont understand what do you want to say......... i am not vba expert.
it's working when i am using only single sheet but i want to validate 3 sheets data. Whenever user save user save it would give pop up first for active sheet then user click ok it should loop other sheets if blank row exist based on column A data.
Here i have posted code only two sheet for example. I hop you will get my point.

[Aflatoon]

As JKwan said, if the first sheet passes your tests, then this line:

        If msg = "" Then 
            Exit Sub 
        Else

will stop the rest of the code from running. Comment out the Exit Sub lines.