How to disable closing workbook before filling in specific cells (if empty)

[K0st4din]

Hello, everyone,
please help you to complete this macro:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sht As Worksheet

Set sht = Application.ThisWorkbook.Worksheets("ime slyjitel")

Application.ScreenUpdating = False

    If sht.Range("D3") = "" Then
        MsgBox "text, text, text, text, text, text, text, "
        End
    ElseIf sht.Range("C2") = "" Then
        MsgBox "text, text, text, text, text, text, text, "
        End
    ElseIf sht.Range("D4") = "" Then
        MsgBox "text, text, text, text, text, "
        End
   ElseIf sht.Range("G4") = "" Then
        MsgBox "text, text, text, text, text, "
        End
   ElseIf sht.Range("B4") = "" Then
        MsgBox "text, text, text, text, "
        End
       
    Else
    End If
    
Application.ScreenUpdating = True
End Sub

Everything in it works, but I don't know how to add something that forbids closing the workbook before the mentioned cells are filled in if they are empty.
Thank you in advance

 

[dmt32]

Hi,

try following

In standard module

Function AllComplete() As Boolean

    Dim rng As Range
    
     With Application
        Set rng = .ThisWorkbook.Worksheets("ime slyjitel").Range("B4,C2,D3:D4,G4")
        AllComplete = .CountA(rng) = rng.Cells.Count
    End With
    rng.Interior.ColorIndex = xlNone
    If Not AllComplete Then
        MsgBox "Complete All Cells", 48, "Entry Required"
        rng.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 3
    End If
    
End Function

In Thisworkbook Code Page

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = Not AllComplete
End Sub

Dave

 

[K0st4din]

Hello dmt32
the macro is very clever,
but in my, text that is displayed, it actually tells the user exactly what he forgot to write.
If possible, let's update it on my macro, I don't need to color the cells because the worksheets are locked.
And I don't want to insert extra lines to unlock and lock while the macro is running.
Thanks in advance

 

[dmt32]

hi,
try this update

Function AllComplete() As Boolean
    Dim i As Integer
    Dim msg As String
    Dim rng As Range, cell As Range

    Set rng = Application.ThisWorkbook.Worksheets("ime slyjitel").Range("B4,C2,D3:D4,G4")
    
    For Each cell In rng.Cells
    i = i + 1
    msg = Choose(i, "msg1", "msg2", "msg3", "msg4", "msg5")
    AllComplete = Len(cell.Value) > 0
    If Not AllComplete Then
        MsgBox "Complete " & msg, 48, "Entry Required"
        rng.Parent.Activate
        cell.Select
        Exit Function
    End If
    Next cell
End Function

Change msg prompts for each cell shown in BOLD as required

Dave

 

[K0st4din]

It's great now.
Thank you very much.
Be alive and healthy and I wish you a pleasant weekend!

 

[dmt32]

It's great now.
Thank you very much.
Be alive and healthy and I wish you a pleasant weekend!

you are welcome
Stay safe yourself

Dave