Khmmm...now, try it again
dim lastRow, numNonBlanks, i as long
lastRow=Range(Cells(65536, ActiveCell.Column).Address).End(xlUp).row
numNonBlanks=0
i=0
range(cells(1,activecell.column)).address).activate
While i<lastRow
if not isempty(activecell.offset(i,0)) then _
numNonBlanks+numNonBlanks+1
i = i + 1
Wend
msgbox numNonBlanks
i hope it's right
ide