VBA count nonblank cells in column of data.

[maxf24]

Hi, I would like a macro to count the number of blank cells in column B divide that by three and place the result as #Meters 3 cells down from last cell with data.


Example: (also the column could have more or less data with more or less blanks.

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"]XYZ[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"]XYZ[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]XYZ[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]Blank[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"]4 Meters[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]
*The Formula for the Cell with # Meters I want it to use blank rows as the qualifier, but because there is a constant of 2 blanks I would like the divide the total of blanks by 2 to return the proper # of Meters. Each string of continuous data represents 1 meter.

This is the Macro I have tried to alter and use from a previous example, but have not had any luck with my limited skill.

Sub NumberofMeters()
Dim r As Range, rAbove As Range
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
Set r = ActiveCell
ActiveCell = Range("B:B").End(xlUp).Offset(2, 0)
Set rAbove = ActiveSheet.Range("B2:" & ActiveSheet.Range("b65536"). _
End(xlUp).Offset(2,0).Address).Select
r.Value = wf.CountBlank(rAbove) / 2
End Sub

Any help would be greatly appreciated!

 

[brian.wethington]

Sub NumberofMeters()
Dim r As Range, rAbove As Range
Dim wf As WorksheetFunction
Dim Sh1 As Worksheet


Set wf = Application.WorksheetFunction
Set Sh1 = ActiveSheet
Set r = Sh1.Cells(Rows.Count, 2).End(xlUp).Offset(3)
Set rAbove = Sh1.Range("B2", r.Offset(-1))
r.Value = wf.CountBlank(rAbove) / 2
End Sub

 

[maxf24]

Brian thanks for the response, but its not returning any value or error!

 

[maxf24]

Brian, it actually did work the first time, it just inserted the solution on a different worksheet(because of my original coding). With a little tweaking it works great! Thanks for your help.

Here is the updated macro:
Sub NumberofMeters()Set wf = Application.WorksheetFunction
Set r = Cells(Rows.Count, 2).End(xlUp).Offset(3)
Set rAbove = Range("B2", r.Offset(-1))
r.Value = wf.CountBlank(rAbove) / 2
End Sub