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
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