Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Detect blank 'rows' in a selected range using excel vba

Posted on 2014-10-17
7
Medium Priority
?
514 Views
Last Modified: 2014-10-19
Dear Experts:

I would like to run a macro that performs the following action:

For the selected range, check whether there are blank rows. If so ...
... display them in a msgbox such as "rows 4, 13, 1578 are blank rows" and ...
... select them.

For example: Range A2 to D40 is selected

If the macro detects that A4, B4, C4, D4 are blank cells, the macro would come up with the msgbox: Row 4 is blank

I hope this is feasible. Help is much appreciated.

Thank you very much in advance for your valuable and professional help.

Regards, Andreas
0
Comment
Question by:AndreasHermle
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
  • +1
7 Comments
 
LVL 27

Assisted Solution

by:ProfessorJimJam
ProfessorJimJam earned 200 total points
ID: 40387163
check this out

Sub Test()
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

0
 
LVL 14

Assisted Solution

by:Farzad Akbarnejad
Farzad Akbarnejad earned 600 total points
ID: 40387171
To show proper message I wrote some codes:

Sub ShowBlank()
    Dim rng As Range
    Dim moreThanOneRow As Boolean
    
    Set rng = Application.Selection
    For i = 1 To rng.Rows.Count
        If rng.Cells(i, 1) = "" Then msg = msg & rng.Cells(i, 1).Row & ", "
    Next i
    If msg <> "" Then
        moreThanOneRow = InStr(InStr(1, msg, ",") + 1, msg, ",") <> 0
        MsgBox "Row" & IIf(moreThanOneRow, "s ", " ") & Left(msg, Len(msg) - 2) & IIf(moreThanOneRow, " are", " is") & " blank" & IIf(moreThanOneRow, "s.", ".")
    Else
        MsgBox "No row is blank."
    End If
End Sub

Open in new window

0
 
LVL 27

Assisted Solution

by:ProfessorJimJam
ProfessorJimJam earned 200 total points
ID: 40387180
the below is the code where you can assign your range in that

this is what exactly you are looking for . you can modify the range

Sub CheckRow()
Dim row As Range
Dim sheet As Worksheet
Set sheet = ActiveSheet



For i = 1 To sheet.Range("A2:D40").Rows.Count

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

Next i
End Sub

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 35

Accepted Solution

by:
[ fanpages ] earned 1200 total points
ID: 40389939
Hi Andreas,

My suggestion is a little more involved, but it does cope with multiple selected Areas of the Active Worksheet, & correctly counts the selected cells within the single (or multiple) Area(s) if the starting column is not [A].

In the code listing below (& within the attached workbook), I have also included a subroutine to create some test data in four Areas (that are then selected), ready to run the main Q_28539617 subroutine to produce the results.

If you require any clarification to set-up &/or run the code, please let me know.

Option Explicit
Public Sub Q_28539617()

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28539617.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28539617
' Question Title:   Detect blank 'rows' in a selected range using excel vba
' Question Asker:   AndreasHermle                 [ http://www.experts-exchange.com/members/AndreasHermle.html ]
' Question Dated:   2014-10-17 at 17:23:25
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2014 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------

  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 Selection.Areas.Count
  
      strRows = ""
      Set rngArea = Nothing
  
      Err.Clear
      lngErr_Number = 0&
      
      blnErr_Ignore = True
      Set rngArea = Intersect(Selection.Areas(lngArea_Selection).SpecialCells(xlCellTypeBlanks).EntireRow, Selection.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 "Selection Area" & _
             IIf(InStr(Selection.Areas(lngArea_Selection).Address, ",") > 0, "s", "") & ":" & _
             vbCrLf & _
             Selection.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
  
  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

Open in new window


BFN,

fp.
Q-28539617.xls
0
 

Author Comment

by:AndreasHermle
ID: 40390356
Dear Experts,

wow, thank you very much for your overwhelming support. This forum is just great.

All of the approaches work just fine, thank you very much but to be honest with you if I do a ranking, which ones are the best and the second best, then the ranking is: 1. fanpages (excellent) and 2. farzad

Will do the point awarding shortly.

Again thank you very much for your professional support. I really appeciate it.

Regards, Andreas
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 40390396
You are very welcome, Andreas.

I am glad I could help.
0
 

Author Closing Comment

by:AndreasHermle
ID: 40391348
Again, thank you very much for your great and professional support. It is really hard to award points, since all solutions work.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question