Help with Count Script

[Braunschweiger]

Okay...I've been working on this all day and can't figure it out so...I'm throwing in the towel and calling in smart people!

What I'm trying to do is...count the number of cells that contain data in one column (there's not data in every cell) and put the total in a specific cell on a different sheet within the same workbook.

The column that contains the data I'm interested in (again...there are cells in this column that don't contain data) is column 4 -- column 2 does contain data in every cell...in case your thinking of an Offset.

Below is everything I've tried and its garbage...none of it worked.

As always, any help would be greatly appreciated!
Dave

Dim wb As Workbook
Set wb = Workbooks("HUD_232_Portfolio_AE_Assignments - TEMPLATE.xlsm")
Dim ws As Worksheet
Set ws = wb.Worksheets("Account Executive Assignments")

Dim wsCK As Worksheet
Set wsCK = wb.Worksheets("Check")

'GoTo DoThis

wsCK.Activate
wsCK.Range("A1").Select

Dim Number_1aa As Integer
Dim Answer1aa As Integer
ws.Activate
ws.Range("B9").Select
Number_1aa = WorksheetFunction.CountA(Range("B9", Range("B9").End(xlDown)))
Answer1aa = Number_1aa
wsCK.Range("C3").Value = Answer1aa

Dim Number_1ab As Integer
'Dim Answer1ab As Variant
ws.Activate
ws.Range("B9").Select
'Number_1ab = WorksheetFunction.CountA(Range("B9", Range("B9").Offset(0, 2).End(xlDown)))
'Number_1ab = Range("B9").End(xlDown).Resize(Columns.Count, _
 Columns.Count).Select
'Number_1ab = Range("B9").End(xlDown).Select
'Dim Rng As Range

'Range("B9").End(xlDown).Offset(0, 2).Select

'Range("D9:" & ActiveCell.Address).Select
'wsCK.Range("C4").Value = Application.WorksheetFunction.CountIf(Rng, "*")

Dim myRange As Range
'Set myRange = Application.Range("B9").End(xlDown).Offset(0, 2).Select
Dim Answer1ab As Variant
'Set Answer1ab = CountIf((myRange), "<> """)

'using excel's built in function CountA to check count of non-blank cells
'if the count is 13 - then msgbox

With Application.Range("B9").End(xlDown).Offset(0, 2).Select
wsCK.Range("C3").Value = Application.WorksheetFunction.CountA(Selection <> "")
End With

'If Application.WorksheetFunction.CountA(myRange) <> "" Then
    'MsgBox "Current Load Full Please Complete & Export", vbCritical
    'Exit Sub
'if the count is less then 13 - then do following
'Else:
    'msg1 = MsgBox("Shipment is short do you want to continue?", vbYesNo)
    'If msg1 = vbYes Then
        'MsgBox "Enter missing products in A2:A14" 'you can run some code here as well
    'Else: Exit Sub
    'End If
'End If

'ActiveRange.Count = Answer1ab

'Answer1ab = Number_1ab
'wsCK.Range("C4").Value = Answer1ab

'Set tbl = ActiveCell.Offset(0, 2).Resize(tbl.Rows.Count - 1, _
 tbl.Columns.Count).Select

'DoThis:

'Dim Answerab As Integer

'ws.Activate
'ws.Range("B9").Select
'Answerab = WorksheetFunction.CountA(Range("B9", Range("B9").End(xlUp)))
'wsCK.Range("C4").Value = Answer1ab

'ws.Activate
'ws.Range("B9").Select
'Range("B9").Select
'WorksheetFunction.CountA (Range("B9", Range("B9").End(xlDown)))
'Selection.Count ("*")

'Dim Rngab As Range
'Dim Answerab As Integer

'For i = 9 To Range("D" & Rows.Count).End(3).Row

'ws.Activate
'ws.Range("B9").Select

'If Cells(i, 2).Value <> "" Then
'Cells(i, 2).Offset(0, 2).Select
'End If
'Next i

'Rngab = Selection.Count
'wsCK.Range("C4").Value = Rngab

'Dim Number_1ab As Integer
'Dim Answer1ab As Integer
'ws.Activate
'ws.Range("D9").Select

'If Cells(i, 2).Value <> "" Then
'Number_1ab = WorksheetFunction.CountA(Cells(i, 2).Offset(0, 2))
'Answer1ab = Number_1ab
'wsCK.Range("C3").Value = Answer1aa
'End If
'Next i
'If Cells(i, 2).Value <> "" Then
'WorksheetFunction.CountA (Cells(i, 2).Offset(0, 2))
'Cells(i, 2).Offset(0, 2).Select
'Selection.Interior.Color = RGB(221, 217, 196)

'End If
'Next i

'Dim counter As Long
    'For i = 9 To Range("D" & Rows.Count).End(3).Row  ' specify your rows
        'For j = 4 ' specify your columns

            'If Cells(i, j) <> "" Then
                'Exit For
            'Else
                'If j = 26 Then counter = counter + 1 ' Alter the col no accordingly
            'End If
        'Next
    'Next

    'MsgBox counter

'Dim rng_1 As Range
'Dim op_cell As Range
'Set rng_1 = Range("D9", Range("*").End(xlDown))
'Set op_cell = wsCK.Range("C4")
'ws.Activate
'ws.Range("D9").Select
'op_cell = WorksheetFunction.CountA(rng_1)

'Dim Number_1ab As Integer
'Dim Answer1ab As Integer
'ws.Activate
'ws.Range("D9").Select
'Number_1ab = WorksheetFunction.CountA(Range("D9"), Range("D9").End(xlDown))
'Answer1aa = Number_1ab
'wsCK.Range("C4").Value = Answer1ab

 

[Yongle]

Try this

Dim wb As Workbook,  ws As Worksheet,  wsCK As Worksheet

Set wb = Workbooks("HUD_232_Portfolio_AE_Assignments - TEMPLATE.xlsm")
Set ws = wb.Worksheets("Account Executive Assignments")
Set wsCK = wb.Worksheets("Check")

wsCK.Range("C3") = WorksheetFunction.CountA(ws.Range("D9", ws.Range("D" & ws.Rows.Count).End(xlUp)))

 

[Braunschweiger]

Try this

Dim wb As Workbook,  ws As Worksheet,  wsCK As Worksheet

Set wb = Workbooks("HUD_232_Portfolio_AE_Assignments - TEMPLATE.xlsm")
Set ws = wb.Worksheets("Account Executive Assignments")
Set wsCK = wb.Worksheets("Check")

wsCK.Range("C3") = WorksheetFunction.CountA(ws.Range("D9", ws.Range("D" & ws.Rows.Count).End(xlUp)))

Wow! That is awesome! Worked perfectly and made my script more efficient. Thanks a TON!!!