- Code: Select all
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const FillCells As String = "B3:B6,D:8,E3:E4"
Const SheetName As String = "Sheet1"
Dim Ws As Worksheet
Dim Msg As String
Dim Sp() As String
Dim Rng As Range
Dim i As Long
Dim R As Long
Set Ws = Sheets(SheetName)
Sp = Split(FillCells, ",")
For i = LBound(Sp) To UBound(Sp)
Set Rng = Ws.Range(Sp(i))
With Rng
For R = 1 To .Cells.Count
If Len(Trim(.Cells(R).Value)) = 0 Then
Msg = "Required data in cell " & _
.Cells(R).Address(0, 0) & _
" have not been supplied." & vbCr & _
"Do you want to save the workbook anyway?" _
& vbCr & vbCr & _
"Press 'No' to complete data entry first."
Cancel = Not MsgBox(Msg, _
vbQuestion + vbYesNo + vbDefaultButton2, _
"Missing data") = vbYes
.Cells(R).Select
Exit Sub
End If
Next R
End With
Next i
End Sub
Const FillCells As String = "B3:B6,D:8,E3:E4"
Const SheetName As String = "Sheet1"
Set the name of your own worksheet and specify the ranges and/or cells that must be filled separated by the standard list separator used in your system (it is a comma for me). Install the above code in the ThisWorkbook code sheet of your VBA project.
When the user tries to save the workbook by any method the program will check the specified ranges. If any of the cells is found blank a message will offer the choice of going back to fill the cell or continue saving. It is possible to do both.
The attached workbook has the same code ready installed for testing.