Prevent user from closing worksheet if cell is blank

Okay, I think this does everything you specified, except for shifting the columns based on user. If you can get this much of it working, we can look at the multi-user part after.

1. Open up the VBA Editor (Alt + F11)
2. Under the VBA Project for your workbook, double-click on "ThisWorkbook"
3. Paste all the code below (this is assuming you don't already have any code in this area)

Option Explicit

' Property we'll use to compare number of rows at Workbook_Open, vs Workbook_Close
Public LastRowAtOpen As Long

Private Sub Workbook_Open()
    
    ' When workbook opens, capture the current last row
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")
    Dim lastrow As Long
    lastrow = ws.Range("A1048576").End(xlUp).Row
    
    ' If below row 1000, reset to pass legacy rows
    If lastrow < 1000 Then
        lastrow = 1000
    End If
    
    ' Set property against which to check when closing workbook
    LastRowAtOpen = lastrow
    
    
    Set ws = Nothing
    Set wb = Nothing
    
    
End Sub


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

    If LastRowAtOpen < 1000 Then
        LastRowAtOpen = 1000
    End If
    
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet1")

    ' Check last row
    Dim lastrow As Long
    lastrow = ws.Range("A1048576").End(xlUp).Row

    ' If below row 1000, reset to pass legacy rows
    If lastrow < 1000 Then
        lastrow = 1000
    End If

    ' Compare current lastrow to LastRowAtOpen
    If lastrow > LastRowAtOpen Then

        ' At least one row was added
        ' Check each new row for empty cells

        Dim problemRows As String
        problemRows = vbNullString

        Dim rng As Range
        Set rng = ws.Range("A" & LastRowAtOpen + 1 & ":E" & lastrow)

        Dim rw As Long
        Dim cl As Variant

        For rw = 1 To rng.Rows.Count
            For Each cl In rng.Rows(rw).Cells
                If cl.Value = vbNullString Then
                    If problemRows = vbNullString Then
                        problemRows = ws.Range(cl.Address).Row
                    Else
                        problemRows = problemRows & ", " & ws.Range(cl.Address).Row
                    End If
                    Exit For
                End If
            Next cl
        Next rw
    End If ' lastrow > LastRowAtOpen


    If problemRows = vbNullString Then
        ' No problems, okay to close
        Cancel = False
        SaveAsUI = True ' Allows launch of "SaveAs" dialog
    Else
        ' Problems
        ' Alert user and block save
        Cancel = True
        MsgBox ("Please complete data entry in row(s): " & problemRows)
        
    End If ' problemRows = vbNullString


    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing

End Sub

Note, you will not be able to save the workbook if there is anything already below line 1000. If that is a problem, change all the places in the code where I specify "1000" to be your actual last row of data.

I could not get the code from gyclone to work and tried another code (below) and could not get that to work either. Basically, I need my range in the worksheet to begin at row 5494 and continue as new rows are created. I'd like the range to be set that if something is entered in column D of the row, Column A and C need to be completed (Column B is hidden, no entry required). The first time I try the code, it works fine and gives me the message prompt or saves the file, but when I reopen it and try again I get an error. Hoping someone can help. Below is the code I was trying to use. The "de-bug" option highlights "rMyRng.SpecialCells(xlCellTypeBlanks).Select" but I'm not sure that is the only issue.


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim nRws As Long, nFilCnt As Long, rMyRng As Range

With Sheets("DOMESTIC")
nRws = .Cells(Rows.Count, "D").End(xlUp).Row
Set rMyRng = Range("a5494:d" & nRws)
nFilCnt = WorksheetFunction.CountA(rMyRng)
If (nRws - 1) * 3 <> nFilCnt Then
rMyRng.SpecialCells(xlCellTypeBlanks).Select
MsgBox "Fill The Selected Blank Cells to Exit This File", vbCritical, "Action Required"
Cancel = True
End If
End With
End Sub

Hi Glycone,

I am a beginner in VBA so am not sure what I need to write.

My worksheet is currently populated with information in rows 1-5494. Many of these rows (97%) do not have any text entered into the date column (Column C).

Since the data spans over many years, it is not possible to go back and populate those cells.

However, going forward, I would like to enforce the discipline of entering the date (Column C) before the worksheet is closed, provided that the cell in Column D is populated with a part number once a new line/row is typed into beginning with row 5495.

Hoping you can provide insight.

Thanks,

Solus,
Thanks for this, it works perfectly.