CODEWITHSUNDEEP
excelvbarows
Hell-1931
Hell-1931

Reputation: 499

Checking on empty (not filled) records in Excel Worksheet

I have excel Worksheet where I used the following vba code, to check on empty records:

     Private Sub Workbook_BeforeClose(Cancel As Boolean)
     On Error GoTo NoBlanks
  
     Dim sh As Worksheet, lastRow As Long, lastCol As Long, emptyCells As Range

    Set sh = ActiveSheet 'use here your sheet
    lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
    lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set emptyCells = sh.Range(sh.Cells(1, 1), sh.Cells(lastRow, 
                                                       lastCol)).SpecialCells(xlCellTypeBlanks)
    If emptyCells.Cells.Count > 0 Then
    MsgBox "There are empty cells, which must be filled: " & emptyCells.Address(0, 0)
    emptyCells.Select
    Else
       Resume Next
   Exit Sub
 End If

  NoBlanks:
     Resume Next

  End Sub

But it still lets me exit out of the Worksheet, even if there empty records

Are there any ways to modify this code - so it wouldn't be possible to close my Worksheet before the records are filled with values?

(I used this code on "Before Close" event)

Upvotes: 0

Views: 74

Answers (1)

Puntal
Puntal

Reputation: 120

Please try following code. I have modified few lines based on your requirements in comments.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  
Dim sh As Worksheet, lastRow As Long, lastCol As Long, emptyCells As Range

Set sh = ActiveSheet 'use here your sheet
lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
'lastRow = sh.UsedRange.Rows.Count

lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
'lastCol = sh.UsedRange.Columns.Count

On Error GoTo NoBlanks
Set emptyCells = sh.Range(sh.Cells(1, 1), sh.Cells(lastRow, _
 lastCol)).SpecialCells(xlCellTypeBlanks)

    If Not emptyCells Is Nothing Then    
        MsgBox "There are empty cells, which must be filled: " & emptyCells.Address(0, 0)
        emptyCells.Interior.Color = RGB(255, 0, 255)
        Cancel = True
    Else  
NoBlanks:
        Cancel = False
        sh.Range(sh.Cells(1, 1), sh.Cells(lastRow, _
 lastCol)).Interior.ColorIndex = 0
        If Me.Saved = False Then Me.Save
        'Workbook will be saved & closed if all cells in UsedRange are filled
    End If
End Sub

Regards.

Upvotes: 1

Related Questions