0

I have written a code which gives me exact count of empty/blank cells in a column/s.

Image

This shows the results if I run the code for column A

  Sub countblank()

    Const column_to_test = 2    'column (B)
    Dim r As Range
    Set r = Range(Cells(2, column_to_test), Cells(Rows.Count, 
    column_to_test).End(xlUp))
     MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows 
     with blank cells in column B")

    Const columns_to_test = 3    'column (C)
    Set r = Range(Cells(3, columns_to_test), Cells(Rows.Count, 
    columns_to_test).End(xlUp))
    MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows 
    with blank cells  in column c ")

    'and so on i can count the blanks for as many columns i want

    End Sub

But the problems are as follows:-

  1. If there are no blanks, this macro will throw an error and will terminate itself. What if I want to run the remaining code?
  2. Using array or something equivalent I want to search the multiple columns by header at the same time, instead of column number that to separately as shown in the code.
  3. If a blank/s is found it pops a Msgbox but can we get the list of error in a separate new sheet called "error_sheet"?
Improve this question

4 Answers 4

Reset to default
2 
Function getBlanksInListCount(ws As Worksheet, Optional FirstRow = 2, Optional TestColumn = 2)
    With ws
        getBlanksInListCount = WorksheetFunction.countblank(.Range(.Cells(FirstRow, TestColumn), .Cells(.Rows.Count, TestColumn).End(xlUp)))
    End With
End Function
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

1

Try this

Sub countblank()

    Dim i As Long

    For i = 2 To 10    ' for looping through the columns
        Dim r As Range
        Set r = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
        'for not getting error and adding error messages in the error_sheet
        'MsgBox ("There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column)
        Sheets("error_sheet").Range(r.Address).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
    Next i
End Sub
Improve this answer

2 Comments

Thanks! Excellent work @Imran Malek, but the error_sheet looks like:- In column 'A' of error_sheet "There are 0 Rows with blank cells in column1" fifteen times as there were 15 rows in column 'A' of sheet1. In column 'B' of error_sheet "There are 2 Rows with blank cells in column2" fifteen times as there were 15 rows in column 'A' of sheet1 . Can we print it single-single lines for each column. And one more thing the position of columns is not known can't we search the columns by their repective headers ?
FYI Data is saved in Sheet1
0

Try sub MAIN to examine the first three columns:

 Sub countblank(column_to_test As Long)

    Dim r As Range, rr As Range, col As String
    col = Split(Cells(1, column_to_test).Address, "$")(1)

    Set r = Range(Cells(2, column_to_test), Cells(Rows.Count, column_to_test).End(xlUp))
    On Error Resume Next
        Set rr = r.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If rr Is Nothing Then
        MsgBox ("There are no Rows with blank cells in column " & col)
    Else
        MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows with blank cells in column " & col)
    End If
    End Sub

Sub MAIN()
    Dim i As Long

    For i = 1 To 3
        Call countblank(i)
    Next i
End Sub
Improve this answer

Comments

0
  1. Q1 can be answered by using an error handling statement. Error handling statements can be as simple or complicated as one would like them to be. The one below is probably my first go to method.

' if no blank cells found, code continues
        On Error Resume Next
        MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & _
            " Rows with blank cells  in column B")

  1. Using headers would work fine. Please see final answer below for this method.

  2. This answer is a minor change from the answer submitted by Imran Malek

Sub countblank()

    Dim i As Long
    ' new integer "row" declared
    Dim row As Integer
    
    ' new integer "row" set
    row = 1

    For i = 2 To 4    ' for looping through the columns
        Dim r As Range
        Set r = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
        'for not getting error and adding error messages in the error_sheet
        'MsgBox ("There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column)
        
        ' using the value in row to insert our output
        Sheets("error_sheet").Range("A" & row).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
        ' adding 1 to "row" to prep for next output
        row = row + 1
    Next i
End Sub

Final answer: My apologies for the lengthy answer. This answer is a modification of Imran Malek's answer, found in the link of answer 3. Please note, this version does not contain error handling, explained in Q1.

Sub countblank()

    Dim Header(1 To 4) As String
        Header(1) = "Name"
        Header(2) = "Age"
        Header(3) = "Salary"
        Header(4) = "Test"
    
        
    Dim i As Integer
    Dim row As Integer
    Dim r As Range
    Dim c As Integer

    row = 1

    ' **NOTE** if you add any more values to {Header}, the loop has to be equal to the Header count
    ' i.e. 4 {Headers}, 4 in the loop
    For i = 1 To 4
    
        'looking for the header in row 1
        c = Cells(1, 1).EntireRow.Find(What:=Header(i), LookIn:=xlValues).Column
        
        'defining the column after header is found
        Set r = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
        
        ' using the value in row to insert our output
        Sheets("error_sheet").Range("A" & row).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
        ' adding 1 to "row" to prep for next output
        row = row + 1
        
        
    Next i
End Sub

Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.