Before save event and check if any cells in the specific range are left blank

Thanks so much for your effort on this. For some reason its not working, It just doesn't play and gives no error message. I typed the sheet name and removed Private I wanted to see the macro in the list. It just won't play no show on my macro list.

Let me clarify , I actually want it save either way even if theinformation is incomplete.
I have column C with Org Name and Column B is first name and column C is last name and column D is status. I want the macro to check if a record exisit in column C with organization name than Coumn B and C and D should be checked for blank spaces. If found blank than remind the user you should fill in the rest of these cells. do you want to proceed yes or no. either way it should be saved.

Again, Thanks MUCH

It works. Did you enable macros? Did you copy the code exactly and paste into VBA in the proper place? Your original post said you needed to check column D through F and now your next post says B,C, and D. Please be consistent so my time isn't wasted. If you want it to save either way just remove the "Cancel = True" line.

Thanks for the prompt reply and sorry for the confusion with the range, my mistake. I did get it to work, using the below code;

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Unprotect Password:="salesforce"
Dim ws As Worksheet: Set ws = Sheets("Contractor Project Information")
Dim lastrow As Long
Dim icell As Range, rCell As Range

lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row

On Error GoTo sEnd
For Each icell In ws.Range("C1:C" & lastrow).SpecialCells(xlCellTypeBlanks)
On Error GoTo sNext
For Each rCell In icell.Offset(0, 1).Resize(lastrow, 4).SpecialCells(xlCellTypeBlanks)
MsgBox ("Please update contractor status in cell " & rCell.Address & ". This workbook will not be saved.")
Cancel = True
Exit Sub
Next rCell
sNext:
Next icell

sEnd:
ActiveSheet.Protect Password:="salesforce"
End Sub


My sheet was protected and that's why it wasn't working. However, I am still having 2 issues with that code. 1) When all cells are completed. I get this error message "Run-Time error '1004': No cells were found. I don't want to be getting thie error, when I debugged the code, it highlightes that section of the code "For Each rCell In icell.Offset(0, 1).Resize(lastrow, 4).SpecialCells(xlCellTypeBlanks)"

The other problem I have is that the code as designed, look for blank cells in columns D through G. But I actually wants it to look for blank cells only if column C has a value. Is that something you can fix. I appreciate your support.

Ok. I amended the code to fit your newest post which appears that you need it for D through G now. It should also not give you an error if all the cells contain a value. That is what the worksheetfunction.CountBlank line should be doing. Technically we could use just that in the code and bypass the use of the second loop, but I like being able to report which cell is still blank. Let me know how it works.

Please Login or Register  to view this content.

Well, it does work like charm. THANK YOU SOOOO MUCH. I have one last question for you if I may, Can I combine 2 before save s? I want to keep the macro you wrote as is and also add something like that,
Private Sub Workbook_BeforeSave(ByVal SaveAsUI _As Boolean, Cancel As Boolean)
MsgBox ("Please remember to update the contractor status column ")
ActiveSheet.Protect Password:="salesforce"
End Sub

Before the user saves after we checked for blank and non blank cells, they would always get this reminder, please remember to update contractor status column.

I trully appreciate your support. THANKS

Thanks again, I pasted the code in the top as shown below and worked great. YOU ARE AWESOME!

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Unprotect Password:="salesforce"
MsgBox ("Please remember to update the contractor status column ")
Dim ws As Worksheet: Set ws = Sheets("Contractor Project Information")
Dim lastrow As Long
Dim icell As Range, rCell As Range

lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row

For Each icell In ws.Range("C3:C" & lastrow)
If Not IsEmpty(icell) Then
If Application.WorksheetFunction.CountBlank(icell.Offset(0, 1).Resize(1, 4)) = 0 Then GoTo sNext
For Each rCell In icell.Offset(0, 1).Resize(1, 4).SpecialCells(xlCellTypeBlanks)
MsgBox ("Please complete the HPwES contractor contact information in cell " & rCell.Address & "")
Exit Sub
Next rCell
End If
sNext:
Next icell

ActiveSheet.Protect Password:="salesforce"
End Sub

Hello, I am having another issue with the code. Its not protecting the sheet in some cases. The below code reminds me about empty cells and the reminder pops up and work great but than leave the sheet unprotected!!

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Unprotect Password:="salesforce"
MsgBox ("Please remember to update participating contractors status. ")
Dim ws As Worksheet: Set ws = Sheets("Contractor Project Information")
Dim lastrow As Long
Dim icell As Range, rCell As Range
lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
For Each icell In ws.Range("C3:C" & lastrow)
If Not IsEmpty(icell) Then
If Application.WorksheetFunction.CountBlank(icell.Offset(0, 1).Resize(1, 4)) = 0 Then GoTo sNext
For Each rCell In icell.Offset(0, 1).Resize(1, 4).SpecialCells(xlCellTypeBlanks)
MsgBox ("Please complete the HPwES contractor contact information in cell " & rCell.Address & "")
Exit Sub
Next rCell
End If
sNext:
Next icell
ActiveSheet.Protect Password:="salesforce"
End Sub

I tried changing the location of the protect commend as shown below, now if there are no empty cells it doesn't protect. Kind of the other way around but still leave it unprotected. I need it to be protected all the time. PLEASE, help!!

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Unprotect Password:="salesforce"
MsgBox ("Please remember to update participating contractors status. ")
Dim ws As Worksheet: Set ws = Sheets("Contractor Project Information")
Dim lastrow As Long
Dim icell As Range, rCell As Range
lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
For Each icell In ws.Range("C3:C" & lastrow)
If Not IsEmpty(icell) Then
If Application.WorksheetFunction.CountBlank(icell.Offset(0, 1).Resize(1, 4)) = 0 Then GoTo sNext
For Each rCell In icell.Offset(0, 1).Resize(1, 4).SpecialCells(xlCellTypeBlanks)
MsgBox ("Please complete the HPwES contractor contact information in cell " & rCell.Address & "")
ActiveSheet.Protect Password:="salesforce"
Exit Sub
Next rCell
End If
sNext:
Next icell
End Sub

Thanks, appreciated!

You can have more than 1 line that protects the sheet. Refer to my post above to see how I set it up so it would protect in multiple situations.

Thanks, Got it to work this way.

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox ("Please remember to update participating contractors status. ")
ActiveSheet.Unprotect Password:="salesforce"
Dim ws As Worksheet: Set ws = Sheets("Contractor Project Information")
Dim lastrow As Long
Dim icell As Range, rCell As Range
lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
For Each icell In ws.Range("C3:C" & lastrow)
If Not IsEmpty(icell) Then
If Application.WorksheetFunction.CountBlank(icell.Offset(0, 1).Resize(1, 4)) = 0 Then GoTo sNext
For Each rCell In icell.Offset(0, 1).Resize(1, 4).SpecialCells(xlCellTypeBlanks)
MsgBox ("Please complete the HPwES contractor contact information in cell " & rCell.Address & "")
ActiveSheet.Protect Password:="salesforce"
Exit Sub
Next rCell
End If
sNext:
Next icell
ActiveSheet.Protect Password:="salesforce"
End Sub

I have one more question PLEASE PLEASE. I would like the macro to run only on sheet called "Contractor Project Information". It gives an error when it runs for the entire excel. Below is the macro, I know i need to add Sub sheet and its name somwhere but not really sure where .
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox ("Please remember to update participating contractors status. ")
ActiveSheet.Unprotect Password:="salesforce"
Dim ws As Worksheet: Set ws = Sheets("Contractor Project Information")
Dim lastrow As Long
Dim icell As Range, rCell As Range
lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
For Each icell In ws.Range("C3:C" & lastrow)
If Not IsEmpty(icell) Then
If Application.WorksheetFunction.CountBlank(icell.Offset(0, 1).Resize(1, 4)) = 0 Then GoTo sNext
For Each rCell In icell.Offset(0, 1).Resize(1, 4).SpecialCells(xlCellTypeBlanks)
MsgBox ("Please complete the HPwES contractor contact information in cell " & rCell.Address & "")
ActiveSheet.Protect Password:="salesforce"
Exit Sub
Next rCell
End If
sNext:
Next icell
ActiveSheet.Protect Password:="salesforce"
End Sub