I follow you now. This code should do it:
Sub MyCountButton()
Dim thisRow As Long
Dim thisCol As Integer
Dim firstRow As Long
Dim headVal As Variant
Dim nextVal As Variant
thisRow = ActiveCell.Row
thisCol = ActiveCell.Column
If thisRow 1 Then
firstRow = Cells(thisRow - 1, thisCol).End(xlUp).Row
Else
firstRow = 1
End If
If firstRow < thisRow Then
headVal = Cells(firstRow, thisCol).Value
nextVal = Cells(firstRow + 1, thisCol).Value
'Checks for header row
If VarType(headVal) = 8 And VarType(headVal) _
< VarType(nextVal) Then
firstRow = firstRow + 1
End If
'Inserts formula
ActiveCell.FormulaR1C1 = "=COUNT(R[" & firstRow _
- thisRow & "]C:R[-1]C)"
'Enters cell for editing - mimic of SUM button
'Delete line below if you want to just accept
'range generated by macro
Application.SendKeys ("{F2}")
End If
End Sub
I will qualify this by pointing out that it is still not as smart as Excel's
sum button. In your example if you used the sum button to add a sum in cell
A4 and then used it again to add a sum to cell A8, A8 would be the sum of
A5-A7. Excel recognises that A4 contains a calculation. My function will not
so if you use if in A4 and then A8 A8 will count A1 - A7. However if you use
it in A8 while A4 is still blank it will (should) work as required. You could
then use it in A4.
Regards
Rowan
"smeesh" wrote:
Sorry Rowan,
I didnt make it very clear. What I meant was:
A1 4
A2 6
A3 9
A4
A5 7
A6 2
A7 1
A8
If I were to do an Autosum in (row) A8 it would automatically try to add the
figures from A5:A7 (noting the break in A4). This is what I would like the
count function to do. At the moment it is counting from A1.
Thanks again.
m
"Rowan" wrote in message
...
I am not totally sure that I have followed your requirement correctly but
what I think you want to do is count from first value down to last value
taking in any blank rows inbetween. If so try this code - just paste it
over
the existing code:
Sub MyCountButton()
Dim thisRow As Long
Dim thisCol As Integer
Dim firstRow As Long
Dim lastRow As Long
Dim headVal As Variant
Dim nextVal As Variant
thisRow = ActiveCell.Row
thisCol = ActiveCell.Column
'Finds first used cell in column
If Cells(1, thisCol).Value = Empty Then
firstRow = Cells(1, thisCol).End(xlDown).Row
Else
firstRow = 1
End If
lastRow = Cells(thisRow, thisCol).End(xlUp).Row
If firstRow < thisRow And lastRow < thisRow Then
headVal = Cells(firstRow, thisCol).Value
nextVal = Cells(firstRow + 1, thisCol).Value
'Checks for header row
If VarType(headVal) = 8 And VarType(headVal) _
< VarType(nextVal) Then
firstRow = firstRow + 1
End If
'Inserts formula
ActiveCell.FormulaR1C1 = "=COUNT(R[" & firstRow _
- thisRow & "]C:R[" & lastRow - thisRow & "]C)"
'Enters cell for editing - mimic of SUM button
'Delete line below if you want to just accept
'range generated by macro
Application.SendKeys ("{F2}")
End If
End Sub
Regards
Rowan
|