Tweaking a macro: Detecting blank rows using VBA

Dear Experts:

below code detects empty rows on the Active Sheet's used range. The blank rows are displayed one at a time in a msgbox.

Could somebody help me re-write this code with the following requirements:

Firstly:
The blank rows are to be displayed in just one message box, such as: Rows 5, 7, 9 are empty
Secondly:
If no blank rows are detected the macro has to call up another macro called 'Lookup_My_Range'

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub EmptyRow()

Dim row As Range
Dim sheet As Worksheet
Set sheet = ActiveSheet

For i = 1 To sheet.UsedRange.Rows.Count

    Set row = sheet.Rows(i)
    If WorksheetFunction.CountA(row) = 0 Then
        MsgBox "row " & i & " is empty"
    End If

Next i

End Sub

Open in new window

Andreas HermleTeam leaderAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rob HensonFinance AnalystCommented:
For i = 1 To sheet.UsedRange.Rows.Count

    Msg = "Row "
    Set row = sheet.Rows(i)
    If WorksheetFunction.CountA(row) = 0 Then
        Msg = Msg & row & " is empty" & chr(10)
    End If

Next i
MsgBox Msg

Open in new window

0
Glenn RayExcel VBA DeveloperCommented:
This code will display a grammatically-correct message (singular/plural) and call the subroutine if no blank rows are detected:

Option Explicit
Sub EmptyRow()
    Dim row As Range
    Dim sheet As Worksheet
    Dim strMsg As String
    Set sheet = ActiveSheet
    Dim i As Long
    
    For i = 1 To sheet.UsedRange.Rows.Count
        Set row = sheet.Rows(i)
        If WorksheetFunction.CountA(row) = 0 Then
            strMsg = strMsg & i & ", "
        End If
    Next i
    
    If Len(strMsg) = 0 Then
        Call Lookup_My_Range
    Else
        strMsg = Left(strMsg, Len(strMsg) - 2) 'lose final comma and space
        If InStr(1, strMsg, ",") = 0 Then
            strMsg = "Row " & strMsg & " is empty."
        Else
            strMsg = "Rows " & strMsg & " are empty."
        End If
        MsgBox strMsg
    End If
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
Sub EmptyRow()

Dim row As Range
Dim i As Long
Dim sheet As Worksheet
Dim msg As String
Set sheet = ActiveSheet

For i = 1 To sheet.UsedRange.Rows.Count

    Set row = sheet.Rows(i)
    If WorksheetFunction.CountA(row) = 0 Then
        msg = msg & "row " & i & " is empty" & vbCrLf
    End If

Next i
MsgBox msg
End Sub

Open in new window

0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

Saurabh Singh TeotiaCommented:
Andres,

A quick question, Now i understand your checking for an empty row by looking at the entire row..But if you can help me understand if i check a particular cell or column like for instance if B Column is empty the row will be empty is that the case is true??

Saurabh...
0
ProfessorJimJamCommented:
Hi Andreas,

i remember this must be a follow up question to the question that i contributed answering.  if you have referred this earlier, then it could have been much easier for everyone.

here i have edited the code exactly as per your need.  see also attached file.

Option Explicit
Public Sub Q_28678459()

' --------------------------------------------------------------------------------------------------------------
' http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28678459.html
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28678459
' Question Title:   Tweaking a macro: Detecting blank rows using VBA
' Question Asker:   AndreasHermle                 [ http://www.experts-exchange.com/members/AndreasHermle.html ]
' Question Dated:   2014-10-17 at 17:23:25  edit requested 2015-05-22 at 17:38:20
'
' original question ID Q_28539617.html code provided by Expert  fanpages
' Edit provided to question ID Q_28678459.html by Expert ProfessorJimJam
  
  
  Dim blnErr_Ignore                                     As Boolean
  Dim intColumn_Finish                                  As Integer
  Dim intColumn_Start                                   As Integer
  Dim intColumns                                        As Integer
  Dim lngArea                                           As Long
  Dim lngArea_Selection                                 As Long
  Dim lngErr_Number                                     As Long
  Dim lngRow                                            As Long
  Dim rngArea                                           As Range
  Dim strErr_Description                                As String
  Dim strRows                                           As String
  
  On Error GoTo Err_Q_28539617
  
  blnErr_Ignore = False
  
  For lngArea_Selection = 1& To ActiveSheet.UsedRange.Areas.Count
  
      strRows = ""
      Set rngArea = Nothing
  
      Err.Clear
      lngErr_Number = 0&
      
      blnErr_Ignore = True
      Set rngArea = Intersect(ActiveSheet.UsedRange.Areas(lngArea_Selection).SpecialCells(xlCellTypeBlanks).EntireRow, ActiveSheet.UsedRange.Areas(lngArea_Selection))
      blnErr_Ignore = False
      
      If Not (rngArea Is Nothing) Then
         For lngArea = 1& To rngArea.Areas.Count
             intColumn_Start = rngArea.Areas(lngArea).Columns(1).Column
             intColumns = rngArea.Areas(lngArea).Columns.Count
             intColumn_Finish = intColumn_Start + intColumns - 1
      
             For lngRow = rngArea.Areas(lngArea).Rows(1&).row To rngArea.Areas(lngArea).Rows(1&).row + rngArea.Areas(lngArea).Rows.Count - 1&
                 If Application.WorksheetFunction.CountBlank(Range(Cells(lngRow, intColumn_Start), _
                                                                   Cells(lngRow, intColumn_Finish))) = intColumns Then
                    strRows = strRows & IIf(Len(Trim$(strRows)) > 0, ", ", "") & CStr(lngRow)
                 End If '  If Application.WorksheetFunction.CountBlank(...) = intColumns Then
          
             Next lngRow
         Next lngArea
      End If 'If Not (rngArea Is Nothing) Then
      
    
  
      MsgBox "ActiveSheet.UsedRange Area" & _
             IIf(InStr(ActiveSheet.UsedRange.Areas(lngArea_Selection).Address, ",") > 0, "s", "") & ":" & _
             vbCrLf & _
             ActiveSheet.UsedRange.Areas(lngArea_Selection).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
             vbCrLf & vbLf & _
             IIf(Len(Trim$(strRows)) = 0&, "No Blank Rows found.", "Blank Row" & IIf(InStr(strRows, ",") > 0, "s", "") & ":" & vbCrLf & strRows), _
             vbInformation Or vbOKOnly, _
             ThisWorkbook.Name
            If Len(Trim$(strRows)) = 0& Then Call Lookup_My_Range
            
         
  
  Next lngArea_Selection

Exit_Q_28539617:

  On Error Resume Next
  
  Exit Sub
  
Err_Q_28539617:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  
  On Error Resume Next
  
  If (blnErr_Ignore) Then
     On Error GoTo Err_Q_28539617
     Resume Next
  End If ' If (blnErr_Ignore) Then
  
  MsgBox "ERROR #" & CStr(lngErr_Number) & _
         vbCrLf & vbLf & _
         strErr_Description, _
         vbExclamation Or vbOKOnly, _
         ThisWorkbook.Name
         
  Resume Exit_Q_28539617
  
End Sub
Public Sub Set_Test_Area_Data()
  
' Clear data from the four Areas...

  Union([A2:D40], [F15:I25], [J23:L29], [J35:L37]).Select
  Selection.ClearContents
  
' First Area test data...

  Union([A2], [B3], [C4], [D5], [C6], [B7], [A8], [B9], [C10], [D11], [C12], [B13], [A14], [B15], [C16]).Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"
  [A17:D17].Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"
  Union([C18], [B19], [A20], [B21], [C22]).Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"
  
' Note: Cells [A23:D23] remain blank
  
  [A24:D24].Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"
  Union([B25], [A26], [B27], [C28], [D29], [C30], [B31], [A32], [B33], [C34], [D35], [C36], [B37], [A38], [B39], [C40]).Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"
  
' Second Area test data...

  [F15:I24].Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"
  
' Note: Cells [F25:J25] remain blank

' Third Area test data...

  Union([J24], [K25:L25], [J28], [L28]).Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"

' Note: Cells [J23:L23], [J26:L26], [J27:L27], & [J29:L29] all remain blank

' Fourth Area test data...

  [J35:L37].Formula = "=SUBSTITUTE(ADDRESS(ROW(),COLUMN()),""$"","""")"

' Hence, expected results...

' Area #1 [A2:D40]  Blank Row:  23
' Area #2 [F15:I25] Blank Row:  25
' Area #3 [J23:L29] Blank Rows: 23, 26, 27, & 29
' Area #4 [J35:L37] No Blank Rows

End Sub

Sub Lookup_My_Range()


' your code here
MsgBox " Lookup_My_Range macro is called now"
End Sub

Open in new window

EE.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andreas HermleTeam leaderAuthor Commented:
Dear all,

thank you very much for your overwhelming support. I really appreciate the time taken and your professional help.

Rob and Martin: great coding, thank you very much for it. I am afraid to tell you that one of my requirements was calling up a specific macro if no blank rows are detected. You to inadvertently missed that.

Glenn: exactly as I wanted it. Thank you very much for it.

Professor JimJam: uups, sorry I was not aware of this. Thank you very much for bringing this to my attention and thank you very much for your wonderful code. Fantastic.
0
Andreas HermleTeam leaderAuthor Commented:
I am really deeply impressed by  your expertise and as for Martin and Rob, I knew that you could have done the same coding as Glenn, but you inadvertently missed my second requirement.

Again, thank you very much for your superb and professional help.

Regards, Andreas
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.