Run Time 1004 Error Unable to get the CountBlank property of the WorksheetFunction class

[Bigblue1702]

All,

I am trying to create a macro that will work with a button to display either answers to a problem if the test has been completed or "Please finish the test before answers will be displayed".

Here is my current code

Sub Button_1()

Dim Answers As Range

Set Answers = Worksheets("Questions").Range("B21,H21,Q21,Y21,AD21,AL21,AU21,BF21,BQ21,CA21,CH21,CR21,DB21,DJ21,DS21,ED21")


If Application.WorksheetFunction.CountBlank(Answers) > 0 Then

MsgBox "Please finish the test before answers will be displayed"
Else
MsgBox "Test" 'This display will be replaced with specific answers to specific questions....
End If


End Sub

Based on a couple hours of debugging and research I believe it has something to do with how I am defining my objects at the top. I am tech/excel savy and have some lite background in programming on a general engineering-level, but I am no master by any means. Any help would be greatly appreciated. Thanks!

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

For reasons known only to Microsoft, you can't use CountBlank like that. It works if the range is contiguous but not otherwise.

So you will need to be a bit more creative. How about:

Sub Button_1()
    Dim r      As Range
    Dim blank  As Boolean
    
    For Each r In Worksheets("Questions").Range("B21,H21,Q21,Y21,AD21,AL21,AU21,BF21,BQ21,CA21,CH21,CR21,DB21,DJ21,DS21,ED21")
        If IsEmpty(r) Then blank = True
    Next
    
    If blank Then
        MsgBox "Please finish the test before answers will be displayed"
    Else
        MsgBox "Test" 'This display will be replaced with specific answers to specific questions....
    End If
End Sub

That loops round the cells in the range and notes if one of them is blank.


Regards,

 

[tonyyy]

I think the following will also work, and doesn't use a loop. (Not that looping through 16 cells will take more than a blink!)

Sub Button_1()
Dim kount As Long
kount = WorksheetFunction.CountA(Range("B21,H21,Q21,Y21,AD21,AL21,AU21,BF21,BQ21,CA21,CH21,CR21,DB21,DJ21,DS21,ED21"))
If kount < 16 Then
    MsgBox "Please finish the test before answers will be displayed"
Else
    MsgBox "Test" 'This display will be replaced with specific answers to specific questions....
End If
End Sub

Cheers,

tonyyy

 

[Bigblue1702]

RickXL and tonyyy,

Thanks for your alls responses! I was actually able to get this one figured out on my own. Here is my code for anyone curious

Sub Button_1()


'Define the cells that the answers will go in
Set Answers = Worksheets("Questions").Range("B21,H21,Q21,Y21,AD21,AL21,AU21,BF21,BQ21,CA21,CH21,CR21,DB21,DJ21,DS21,ED21")

'Set a counter to count the number of blank cells
counter = 0
For Each cellObject In Answers
    If cellObject.Value = "" Then counter = counter + 1
    Next
    
'Determine the value of counter. If there are any blank answers, the correct answer will not be displayed.
    If counter > 0 Then
        MsgBox "Please finish the test before answers will be displayed"
    Else
        MsgBox "Test"
    End If

End Sub

Thanks again!

 

[ask2tsp]

Yet another, slightly different way

Option Explicit

Sub testComplete()
    Dim Answers As Range

    Set Answers = Range("B21,H21,Q21,Y21,AD21,AL21,AU21,BF21,BQ21,CA21,CH21,CR21,DB21,DJ21,DS21,ED21")
    
    If WorksheetFunction.CountA(Answers) < Answers.Count Then
        MsgBox "Please finish the test before answers will be displayed"
    Else
        MsgBox "Test"
    End If
End Sub