Can't get VBA code to prevent "Save As" from working with this code

[Chassee]

Hi There. I have a code below that should be preventing excel from a user being able to save as without a certain range of cells filled out based on the parameters in my code. I thought it would work just fine, but in testing it will show the message box and then save anyways. Please help. Thanks

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim rngCell As Range

For Each rngCell In Range("J22:K51")
If rngCell.Value > "" And rngCell.Offset(0, -9).Value = "" Then
MsgBox "NEXT SVC DUE missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
Exit Sub
End If
Next

End Sub

 

[JEC]

Write
Cancel = True instead of Exit Sub

 

[Chassee]

Write
Cancel = True instead of Exit Sub

You are a genius!!! Hey if I want the cell to be selected where the problem is should I put this before or after that line you gave me:

rngCell.Offset(0,-9).Select

 

[JEC]

Try putting that before

 

[Chassee]

Try putting that before

Thank you. I am also wondering now since you are so helpful. With that working out, can it also automatically go to the selected cell instead of staying in the save as screen?

 

[JEC]

Put SaveAsUI = False above cancel=true

 

[Chassee]

Put SaveAsUI = False above cancel=true

That didn't seem to work. When I went to save after the prompts came up it still stayed on the Save As Screen. If this isn't possible it is not a make or break thing. Just a nice to have thing

 

[Chassee]

That didn't seem to work. When I went to save after the prompts came up it still stayed on the Save As Screen. If this isn't possible it is not a make or break thing. Just a nice to have thing

I should've given you the rest of the code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim rngCell As Range

For Each rngCell In Range("J22:K51")
If rngCell.Value > "" And rngCell.Offset(0, -9).Value = "" Then
MsgBox "NEXT SVC DUE missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
rngCell.Offset(0, -9).Select
SaveAsUI = False
Cancel = True
End If

If rngCell.Value > "" And rngCell.Offset(0, -6).Value = "" Then
MsgBox "LOCATION missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
rngCell.Offset(0, -6).Select
SaveAsUI = False
Cancel = True
End If

If rngCell.Value > "" And rngCell.Offset(0, -2).Value = "" Then
MsgBox "SIZE missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
rngCell.Offset(0, -2).Select
SaveAsUI = False
Cancel = True
End If

If rngCell.Value > "" And rngCell.Offset(0, -1).Value = "" Then
MsgBox "TYPE missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
rngCell.Offset(0, -1).Select
SaveAsUI = False
Cancel = True
End If

If rngCell.Value = "Fail" And rngCell.Offset(0, 1).Value = "" Then
MsgBox "COMMENTS missing on Failed FE's - Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
rngCell.Offset(0, 1).Select
SaveAsUI = False
Cancel = True
End If
Next


End Sub

 

[JEC]

Ah ok and how about this? I just did it for the first part

For Each rngCell In Range("J22:K51")
  If rngCell.Value > "" And rngCell.Offset(0, -9).Value = "" Then
  MsgBox "NEXT SVC DUE missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
  rngCell.Offset(0, -9).Select
  Cancel = True
  Exit For
End If

 

[Chassee]

Ah ok and how about this? I just did it for the first part

For Each rngCell In Range("J22:K51")
  If rngCell.Value > "" And rngCell.Offset(0, -9).Value = "" Then
  MsgBox "NEXT SVC DUE missing on Extinguisher Sheet", vbInformation, "Dignity Fire Protection"
  rngCell.Offset(0, -9).Select
  Cancel = True
  Exit For
End If

Thanks for this one too... But it still keeps us on the Save as screen after prompts appear