Solved

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

Posted on 2014-10-17
7
310 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
  • 2
  • 2
  • 2
  • +1
7 Comments
 
LVL 25

Assisted Solution

by:ProfessorJimJam
ProfessorJimJam earned 50 total points
Comment Utility
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 150 total points
Comment Utility
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 25

Assisted Solution

by:ProfessorJimJam
ProfessorJimJam earned 50 total points
Comment Utility
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 35

Accepted Solution

by:
[ fanpages ] earned 300 total points
Comment Utility
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
Comment Utility
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 ]
Comment Utility
You are very welcome, Andreas.

I am glad I could help.
0
 

Author Closing Comment

by:AndreasHermle
Comment Utility
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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

763 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now