If cell is empty in a variable range, stop macro and return error message

Hi, Andrei,

using ScpecialCells(xlCellTypeBlanks) comes to my mind when I read what you are after:

Sub Andrei()

Dim lngLast As Long
Dim strMsg As String
Dim rngCell As Range

With ActiveSheet
  lngLast = .Cells(Rows.Count, "E").End(xlUp).Row
  With .Range(.Cells(2, "E"), .Cells(lngLast, "E"))
    On Error Resume Next
    If .SpecialCells(xlCellTypeBlanks).Cells.Count > 0 Then
      If Err = 0 Then
        For Each rngCell In .SpecialCells(xlCellTypeBlanks)
          strMsg = strMsg & rngCell.Address(0, 0) & vbNewLine
        Next rngCell
        MsgBox "Please fill out the following cells:" & vbCrLf & strMsg & "and start macro again.", vbInformation
        Exit Sub
      End If
    End If
    On Error GoTo 0
  End With
End With
End Sub

Ciao,
Holger

Hi Holger,

I think I was too rushy to mark this thread as solved. There are 2 problems with this code. First, the range for lngLast could be the entire column E in case all cells in E are left blank. Second, when I fill in at least 1 cell in the column the code doesn't seem to work anymore as it accepts all other blank cells in the column. Now, if I think correctly, I can replace "E" in lngLast = .Cells(Rows.Count, "E").End(xlUp).Row with "A" (rows.count for column A) and use that count in the next line. However, I can't figure out what's wrong with the code concerning the second issue.

Can you, please, help me with that?

Regards,
Andrei

Hi, Andrei,

you´re correct about the failure if no entry inside the range has been made prior to running the code.

Let´s try it this way:

Sub Andrei_2()

Dim lngLast As Long
Dim strMsg As String
Dim rngCell As Range
Dim rngArea As Range

With ActiveSheet
  lngLast = .Cells(Rows.Count, "A").End(xlUp).Row
  Set rngArea = .Range(.Cells(2, "E"), .Cells(lngLast, "E"))
  If WorksheetFunction.CountBlank(rngArea) > 0 Then
    For Each rngCell In rngArea.SpecialCells(xlCellTypeBlanks)
      strMsg = strMsg & rngCell.Address(0, 0) & vbNewLine
    Next rngCell
    MsgBox "Please fill out the following cells:" & vbCrLf & strMsg & "and start macro again.", vbInformation
    Exit Sub
  End If
End With
End Sub

Ciao,
Holger

I tried just

 Set rngArea = Application.Union(.Range(.Cells(2, "E"), .Cells(lngLast, "f")),.Range(.Cells(2, "H"), .Cells(lngLast, "H")))

but it failed on

If WorksheetFunction.CountBlank(rngArea) > 0

This works

Sub Andrei_2()
Dim lngLast As Long
Dim strMsg As String
Dim rngCell As Range
Dim rngArea As Range

With ActiveSheet
  lngLast = .Cells(Rows.Count, "A").End(xlUp).Row
  Set rngArea = Union(.Range(.Cells(2, "E"), .Cells(lngLast, "f")), .Range(.Cells(2, "h"), .Cells(lngLast, "h")))
    For Each rngCell In rngArea
    If rngCell.Value = vbNullString Then
      strMsg = strMsg & rngCell.Address(0, 0) & vbNewLine
    End If
    Next rngCell
    MsgBox "Please fill out the following cells:" & vbCrLf & strMsg & "and start macro again.", vbInformation
    Exit Sub
End With
End Sub