VBA to check if any cell is not blank in given range

Question

I have the below code that will throw a prompt when a particular sheet is empty before saving the workbook.

Purpose of code: To check, if value of drop-down is "yes" in Main Sheet and if "yes", check if given range on a particular sheet is blank. If "yes", throw a prompt and change the drop down value to "No" on main sheet.

Concern: For loop in the code will check if any cell is empty in given range, instead, I want a code to check if there is an entry in any one cell in given range. Lets say given range is E10:G19, if we have an entry in E10, It should come out of the code and should not throw a prompt and should throw only if all the cells in given range is empty.

Question: What should replace my For loop that can serve my purpose?

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

Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")

If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
        If IsEmpty(cell) Then
            bOk = True
            Exit For
        Else: bOk = False
        End If
Next

If bOk Then
    If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
    Worksheets("Main").Range("E29").Value = "NO"
    Cancel = True
    End If
End If
End If
End Sub

Answer 1

Here you go:

Option Explicit

Public Function b_is_range_empty(my_rng As Range)

    If Application.WorksheetFunction.CountA(my_rng) > 0 Then
        b_is_range_empty = False
    Else
        b_is_range_empty = True
    End If

End Function

Public Sub TestMe()

    Debug.Print b_is_range_empty(Selection)

End Sub

The idea is to use the built-in formula in Excel - CountA. It is optimized for faster search. In the test it works with selection of the area.

Edit: In stead of this:

For Each cell In Rvalue
        If IsEmpty(cell) Then
            bOk = True
            Exit For
        Else: bOk = False
        End If
Next

Write simply this: bOK = b_is_range_empty(Rvalue)

Answer 2

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

Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")

If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
        If IsEmpty(cell)<>true Then
            bOk = false
            Exit For
        Else: bOk = true
        End If
Next

If bOk Then
    If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
    Worksheets("Main").Range("E29").Value = "NO"
    Cancel = True
    End If
End If

If bOk=false Then
    If MsgBox("Sheet is not blank", vbOKCancel + vbInformation) = vbOK Then
    Worksheets("Main").Range("E29").Value = "Yes"
    Cancel = True
    End If
End If

End If
End Sub

Answer 3

You appear to be exiting your for loop when the first cell is empty, you will want it to only exit when it finds a value instead:

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

Dim Rvalue As Range
Dim cell As Range
Set Rvalue = Sheets("Uni-corp").Range("E10:G19")

If Worksheets("Main").Range("E29").Value = "YES" Then
For Each cell In Rvalue
        If IsEmpty(cell) Then
            bOk = True
            'Exit For moved to Else section
        Else: bOk = False
        Exit for
        End If
Next

If bOk Then
    If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
    Worksheets("Main").Range("E29").Value = "NO"
    Cancel = True
    End If
End If
End If
End Sub

Answer 4

Maybe you're after something like this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)    
    If UCase(Worksheets("Main").Range("E29").Value) <> "YES" Then Exit Sub
    If WorksheetFunction.CountA(Worksheets("Uni-corp").Range("E10:G19")) > 0 Then Exit Sub
    If MsgBox("Sheet is blank", vbOKCancel + vbInformation) = vbOK Then
        Worksheets("Main").Range("E29").Value = "NO"
        Cancel = True '<--| this will make the macro not save the workbook
    End If
End Sub