VBA code for Pop-Up when cells are blank or zero

sneel3

Active Member
Joined
Oct 9, 2002
Messages
331
I need to warn users that there are blank cells that need to be filled in. I would like to do this when they try to save (or save as) the file. How do I create a pop-up that tells them that "There are empty cells that need to be filled in"?
 

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
OK, try this.
(Replaces the entire code you currently have.)
It should also be considerably quicker because I've eliminated the looping.
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim LstRw As Long, _
    ChkRng As Range, _
    mnOK As Boolean, _
    pOK As Boolean, _
    L4OK As Boolean
mnOK = False: pOK = False: L4OK = False
    
With Sheets("Sheet1") 'Change to the sheet of choice
  If .Range("L4") = "0" Then L4OK = True
  LstRw = .Cells(Rows.Count, "L").End(xlUp).Row
  On Error Resume Next
  Set ChkRng = .Range("M11:N" & LstRw).SpecialCells(xlCellTypeBlanks)
  If Err.Number <> 0 Then
    mnOK = True
    Err.Clear
  End If
  Set ChkRng = .Range("P11:P" & LstRw).SpecialCells(xlCellTypeBlanks)
  If Err.Number <> 0 Then
    pOK = True
    Err.Clear
  End If
  If L4OK = True And mnOK = True And pOK = True Then
    GoTo AllsCool
  Else
    If Not L4OK = True Then
      If MsgBox("The value in range L4 does not equal zero." & Chr(10) & Chr(10) & _
      "Continue with the save or cancel?", vbOKCancel, "Save anyway?") = vbCancel Then
        Cancel = True
        .Select
        .Range("L4").Select
        Exit Sub
      End If
    End If
  End If
  If mnOK = False Or pOK = False Then
    If MsgBox("All cells in the ranges" & Chr(10) & _
      "M11 to  N" & LstRw & " and" & Chr(10) & _
      "P11 to  P" & LstRw & Chr(10) & _
      "should have an entry before saving." & Chr(10) & Chr(10) & _
      "Continue with the save or cancel?", vbOKCancel, "Save anyway?") _
      = vbCancel Then
        Cancel = True
        .Select
        If Not mnOK = True Then
          .Range("M11").Select
          Exit Sub
        End If
        If Not pOK = True Then
          .Range("P11").Select
          Exit Sub
        End If
    End If
  End If
End With

AllsCool:
End Sub
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
:LOL: My wife shudders at the thought.
Says that's all the world needs... another me.

Glad it helped.
 

seenfresh

Well-known Member
Joined
Jul 12, 2006
Messages
1,141
If you can get it to make coffee for you!

You have to let me know when that happens! I'm all for it!

If it could dress me and open my beer, then your a genius!

Cheers!
 

HalfAce

MrExcel MVP
Joined
Apr 6, 2003
Messages
9,456
Open your beer?
Man I'll be happy when I can make it just go get one for me! :biggrin:
 

Forum statistics

Threads
1,144,369
Messages
5,723,952
Members
422,528
Latest member
IMK

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top