Applying Count formula to the range of an existing sum formula

[harry2908]

Hi,

There is a sum formula applied in column J of a sheet, which totals figures above it. I need another formula besides it which would count the number of items used in that sum formula.

Can someone suggest a formula or a macro for the same.

Thanks..

 

[p45cal]

Duplicate errors are likely to be caused by two or more macros having the same name in the same workbook. Change the name or delete duplicate macros.
I've made some changes to avoid selecting anything at all.
Note I've made a change to the sorting; originally you only sorted column B, without changing any other columns. I've changed it to sort, still based on column B, but all columns from A to P are sorted. If this is wrong, change the A an P back to B and B (or if P is not the last column in the table, change the P to the appropriate letter.
There's also another change in red in the code (J2, lower down); check this is right.

Sub d_CellColor_Total_COuntMR_EXCEL()
Dim i As Long, j As Long
Dim k As Integer, l As Integer
Dim LastRow As Long
Dim ws As Object
For Each ws In Worksheets
  With ws
    If Application.WorksheetFunction.CountA(.Range("A2:J20")) > 0 Then
      LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range("[B][COLOR=Red]A[/COLOR][/B]1:[B][COLOR=Red]P[/COLOR][/B]" & LastRow).Sort Key1:=.Range("B1"), Order1:=xlDescending, Header:=xlYes, _
                                    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                    DataOption1:=xlSortNormal
      For i = LastRow To 2 Step -1
        With .Range("A" & i & ":P" & i)
          If .Cells(2).Value >= 0 And .Cells(2).Value <= 9 Then .Interior.ColorIndex = 36
          If .Cells(2).Value >= 10 And .Cells(2).Value <= 14 Then .Interior.ColorIndex = 4
          If .Cells(2).Value >= 15 And .Cells(2).Value < 20 Then .Interior.ColorIndex = 44
          If .Cells(2).Value >= 20 And .Cells(2).Value < 100 Then .Interior.ColorIndex = 3
        End With
      Next i
      k = 3
      For j = LastRow To 2 Step -1
        With .Range("B" & j + 1)
          If .Offset(-1).Interior.Color <> .Interior.Color Then
            For l = 1 To k
              .EntireRow.Insert
              .Offset(-1).EntireRow.Clear
            Next l
          End If
        End With
      Next j

      Dim LR As Long
      Dim Area As Range
      LR = .Range("J" & .Rows.Count).End(xlUp).Row
      If LR = 2 Then
        .Range("J4").Formula = "=SUM(J2)"
        .Range("K4").Formula = "=COUNT([B][COLOR=Red]J[/COLOR][/B]2)"
        .Range("K4").Font.ColorIndex = 2
        'I'm guessing that B2 is the right cell to look at:
        .Range("A4").Value = Choose(Application.Match(.Range("B2").Value, Array(0, 10, 15, 20), 1), "a", "b", "c", "d")
        .Range("A4").Font.ColorIndex = 2
      Else
        For Each Area In .Range("J2:J" & LR).SpecialCells(xlCellTypeConstants).Areas
          With Area.Resize(1).Offset(Area.Rows.Count + 1)
            .Formula = "=SUM(" & Area.Address & ")"
            .Offset(0, 1).Formula = "=COUNT(" & Area.Address & ")"
            .Offset(0, 1).Font.ColorIndex = 2
            ws.Cells(.Row, "A").Font.ColorIndex = 2
            ws.Cells(.Row, "A").Value = Choose(Application.Match(ws.Cells(Area.Row, "B").Value, Array(0, 10, 15, 20), 1), "a", "b", "c", "d")
          End With
        Next Area
      End If
    End If
  End With
Next ws
End Sub