Macro que cuente

Hola barsimpson, aquí consultándote sobre una macro. Explico lo que quiero hacer y posteriormente te anexo el código que ya llevo. Se tienen 4 columnas: envío, reorden, devolución, venta y porcentaje de venta:
envio reorden devolucion venta %
1             *              *           5     0%
2             *              *           4    20%
1             *              *           2    15%
2             *              *           2     -2%
3             *              *           1    100%
3             *              *           3     50%
5             *              *           4       0%
2             *              *           5     70%
2             *              *           2     80%
por medio de la columna de % se van a hacer rangos que van así:
menor o igual que cero
mayor que cero y menor que 50
Mayor o igual que 50 y menor o igual que 70
mayor que 70
con base a estos rangos, se van a sumar Y contar los valores de la columna de envío, es decir para menor o igual que cero solo se tomaran 1, 2 y 5 y los sumará o sea 8, y también va a contar o sea son 3. La macro que tengo ya hace la parte de la suma, pero falta que cuente. Aquí esta lo que tengo (esto ya funciona perfecto)
Sub ordena()
Dim fila1 As Integer, fila As Integer
Dim ultimacol As Integer, ultimafila As Integer
Dim tot1 As Long, tot2 As Long, tot3 As Long, tot4 As Long
Dim pv1 As Long
fila1 = 6
'busca la ultima columna
If WorksheetFunction.CountA(Cells) > 0 Then
ultimacol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
End If
'busca la ultima fila
If WorksheetFunction.CountA(Cells) > 0 Then
ultimafila = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
'busca operaciones invalidas y deja en blanco la celda
For fila = fila1 To ultimafila - 1
If IsError(Cells(fila, ultimacol).Value) Then
If Cells(fila, ultimacol).Value = CVErr(xlErrDiv0) Then
Cells(fila, ultimacol).Value = ""
End If
End If
Next fila
'busca rangos para hacer las sumas
For fila = fila1 To ultimafila - 1
If Cells(fila, ultimacol).Value <= 0 Then
Cells(fila, ultimacol - 4).Font.ColorIndex = 4
tot1 = tot1 + Cells(fila, ultimacol - 4).Value aqui solo esta sumando
Else
If Cells(fila, ultimacol).Value >= 0.01 And Cells(fila, ultimacol).Value <= 0.494 Then
Cells(fila, ultimacol - 4).Font.ColorIndex = 3
tot2 = tot2 + Cells(fila, ultimacol - 4).Value
Else
If Cells(fila, ultimacol).Value >= 0.495 And Cells(fila, ultimacol).Value < 0.705 Then
Cells(fila, ultimacol - 4).Font.ColorIndex = 7
tot3 = tot3 + Cells(fila, ultimacol - 4).Value
Else
If Cells(fila, ultimacol).Value > 0.7055 Then
Cells(fila, ultimacol - 4).Font.ColorIndex = 9
tot4 = tot4 + Cells(fila, ultimacol - 4).Value
End If
End If
End If
End If
Next fila
MsgBox tot1 & " " & tot2 & " " & tot3 & " " & tot4
End Sub
Muchas gracias!