Cells required before close

[RattlingCarp3048]

I have a shared workbook that anyone can add data to. The user will open the workbook and add data to the next available row. Column A is always filled in 100% when they add data. If data is entered into column A, then columns B-J are required. Problem is...users are constantly leaving some portion of B-J empty and i am having to remind them or go behind them to fill in the information and that is just waaaaayyyy too much upkeep for one person. I suspect VBA would be the best way to go about this but im open to other options. The actual text itself doesnt matter.

Can someone help with a way to prevent the workbook from being closed if column A is not blank and any cell on that row between B-J is blank then the workbook will not close? Bonus points for an error message that tells the user which cell they left blank.

Any and all help appreciated

free text	dropdown list	dropdown list	date	date	formula	dropdown list	free text	dropdown list	dropdown list
apple	1	single	1/17/2025	1/17/2025	mmmm	paid	granny smith	yes	no	a=not blank and B-J are completed = close workbook
banana	3	bundles	1/17/2025	1/17/2025	mmmm	paid		yes	yes	a=not blank and no data in H = workbook will not close
grape	1	packages	1/17/2025	1/17/2025	mmmm		package of red grapes	no	yes	a=not blank and no data in G = workbook will not close
kiwi	4		1/17/2025	1/17/2025	mmmm	pending	yellow kiwi's	no	no	a=not blank and no data in C = workbook will not close
										a=blank = close workbook

 

[Logit]

Paste the following macros into the ThisWorkbook module. It runs automatically if the user fills in Col A but any cell in Cols B:J are empty.
Or ... if the user has data in any cell B:J but has Col A empty.

Option Explicit

' Event triggered before saving the workbook
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call CheckCells(Cancel)
End Sub

' Event triggered before closing the workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call CheckCells(Cancel)
    
    If Me.Saved = False And Cancel = True Then
        MsgBox "Please complete all required fields before closing the workbook.", vbExclamation
    End If
End Sub

' Checks cells across worksheets for missing data
Private Sub CheckCells(ByRef Cancel As Boolean)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim errors As String
    Dim hasData As Boolean

    ' Loop through all worksheets in the workbook
    For Each ws In ThisWorkbook.Worksheets
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        
        ' Extend lastRow to ensure it captures data in columns B:J
        lastRow = Application.WorksheetFunction.Max(lastRow, ws.Cells(ws.Rows.Count, "J").End(xlUp).Row)
        
        ' Loop through rows
        For i = 1 To lastRow
            hasData = False
            
            ' Check if there is data in columns B:J
            For j = 2 To 10
                If ws.Cells(i, j).Value <> "" Then
                    hasData = True
                    Exit For
                End If
            Next j
            
            ' Validate column A if there is data in columns B:J
            If hasData And ws.Cells(i, 1).Value = "" Then
                errors = errors & ws.Name & " - Row " & i & ": Column A must not be empty when columns B:J contain data." & vbCrLf
                Cancel = True
            End If

            ' Validate columns B:J if column A has data
            If ws.Cells(i, 1).Value <> "" Then
                For j = 2 To 10
                    If ws.Cells(i, j).Value = "" Then
                        errors = errors & ws.Name & " - Row " & i & ": Please fill in all cells from B to J." & vbCrLf
                        Cancel = True
                        Exit For
                    End If
                Next j
            End If
        Next i
    Next ws

    ' If errors exist, display them in a single message box
    If errors <> "" Then
        MsgBox "The following issues must be corrected before proceeding:" & vbCrLf & errors, vbExclamation
    End If
End Sub

 

[RattlingCarp3048]

Thanks! I have already left for the weekend but will try Monday.

Question... the workbook auto-saves. Will this be affected by the macro? I noticed you have a msg for when it saves

 

[Logit]

If the same conditions exist as outlined previously the auto save isn't going to work. The same error messages will be displayed.
No way of getting around that.

 

[RattlingCarp3048]

If the same conditions exist as outlined previously the auto save isn't going to work. The same error messages will be displayed.
No way of getting around that.

Yes. The same conditions will still apply.

If the user is in the process of adding data and the file tries to auto save they will get the error messege even though they aren't finished? Just making sure I understand.

 

[Logit]

Yes, it should respond that way. Give it a try on a copy of your workbook just in case something goes amiss.

 

[Artik]

Logit, analyze the following strategy.
1. The number of loops looking for empty cells can be reduced, although this may come at the expense of more detailed messages.
2. You cannot forbid the user to close the workbook without saving (data abandonment).
3.

' Extend lastRow to ensure it captures data in columns B:J

What if the user does not fill in the data in column J and does not fill in column A, but fills in any of the columns B:I?

4. In this task it is rather unimportant, but when you are fighting for milliseconds, rather than

ws.Cells(i, 1).Value = ""
ws.Cells(i, 1).Value <> ""

use

Len(ws.Cells(i, 1).Value) = 0
Len(ws.Cells(i, 1).Value) > 0

Text comparison is slower than string length calculation.

5. Take a look at the AutoRecover and AutoSaveOn properties.

End of torture.

Option Explicit


' Event triggered before saving the workbook
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Call CheckCells(Cancel)

    If Cancel Then
        MsgBox "Please complete all required fields before closing the workbook.", vbExclamation
    End If
End Sub


' Checks cells across worksheets for missing data
Private Sub CheckCells(ByRef Cancel As Boolean)
    Dim Ws As Worksheet
    Dim lastRow As Long
    Dim errors As String
    Dim ColsCnt As Long
    Dim rngData As Range
    Dim rng As Range

    ColsCnt = 10

    ' Loop through all worksheets in the workbook
    For Each Ws In Me.Worksheets
        errors = vbNullString

        lastRow = GetLastRowCell(Ws.UsedRange).Row

        Set rngData = Ws.Range("A1").Resize(lastRow, ColsCnt)

        For Each rng In rngData.Rows
            If Application.CountA(rng) <> ColsCnt Then
                errors = errors & rng.Row & ", "
            End If
        Next rng

        If Len(errors) > 0 Then
            errors = Left(errors, Len(errors) - 2)
            MsgBox "In sheet '" & Ws.Name & "', complete rows no: " & errors & String(2, vbLf) & _
                   "Saving the file is not possible!", vbCritical
            Cancel = True
        End If
    Next Ws

End Sub


Function GetLastRowCell(InRange As Range) As Range
' By Chip Pearson,  www.cpearson.com
    Dim R As Range
    Dim LastCell As Range
    Dim RR As Range

    With InRange.Worksheet
        If InRange.Cells.CountLarge = 1 Then
            Set RR = .UsedRange
        Else
            Set RR = InRange
        End If

        Set R = RR(RR.Cells.CountLarge)

        Set LastCell = RR.Find(What:="*", After:=R, LookIn:=xlValues, _
                               LookAt:=xlPart, SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious, MatchCase:=False)

        If Not LastCell Is Nothing Then
            Set GetLastRowCell = LastCell
        Else
            Set GetLastRowCell = .Cells(1)
        End If

    End With

End Function

Artik