PDA

View Full Version : Need help in event



online
07-25-2011, 10:25 AM
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
07-25-2011, 10:52 AM
Just by glancing over your code, your EXIT SUB will exit the subroutine when the user fullful the requirements!

CatDaddy
07-25-2011, 04:30 PM
you also dont reset the last row, in case its different on the second sheet?

online
07-26-2011, 09:06 PM
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
07-27-2011, 01:08 AM
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.