Applying Count formula to the range of an existing sum formula

H

harry2908

Board Regular
Joined
May 7, 2010
Messages
87
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..
 
Sort by date Sort by votes
after:
.Range("J4").Formula = "=SUM(J2)"
add:
.Range("K4").Formula = "=COUNT(J2)"
.Range("K4").Font.ColorIndex = 2
 
Upvote 0

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Thanks will try it.

Also, where it does the total & the count
Can it place an "a" on the extreme left of the total row for color 36
"b" for color 4
"c" for 44 &
"d" for 3

Thanks for all your help..!
 
Upvote 0
I don't really understand the request, so this is probably not what you want;
after:
.Range("K4").Font.ColorIndex = 2
add:
Code: 
With Range("A4")
    .Value = "abcd"
    .Characters(Start:=1, Length:=1).Font.ColorIndex = 36
    .Characters(Start:=2, Length:=1).Font.ColorIndex = 4
    .Characters(Start:=3, Length:=1).Font.ColorIndex = 44
    .Characters(Start:=4, Length:=1).Font.ColorIndex = 3
End With
and also add after:
.Offset(0, 1).Font.ColorIndex = 2
Code: 
With Cells(.Row, "A")
    .Value = "abcd"
    .Characters(Start:=1, Length:=1).Font.ColorIndex = 36
    .Characters(Start:=2, Length:=1).Font.ColorIndex = 4
    .Characters(Start:=3, Length:=1).Font.ColorIndex = 44
    .Characters(Start:=4, Length:=1).Font.ColorIndex = 3
End With
 
Upvote 0
i will try to explain it in detail.

The below macro segregates & colors the rows according to column B.
if the B column value is b/w 0-9 it colours it light yellow, does a total & Count. i want to add an "a" in column A of the row where it does the total

similarly if the B column value is b/w 10-14 it colours it & does a total & Count. i want to add an "b" in column A of the row where it does the total

"c" for 15-19
"d" for 20-above

can this be added in the existing macro..?
 
Upvote 0
As far as I can tell (and remember, I can't see your sheet) the rows with the totals on have no colour, and the rows above them can have multiple colours. So on which cell's colour/value does the cell in column A of the totals row depend?
 
Upvote 0
The colouring is based on the value in the column B. if the value in column B is between 0-9 then row colour will be light yellow. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p>
It would add three blank rows, then<o:p></o:p>
<o:p> </o:p>
In case the value is b/w 10-14 the row colour will be Light Green<o:p></o:p>
<o:p> </o:p>
It would add three blank rows, <o:p></o:p>
<o:p> </o:p>
Similarly for value 15-20 colour will be Gold <o:p></o:p>
<o:p> </o:p>
It would add three blank rows,<o:p></o:p>
<o:p> </o:p>
20 & above Red. <o:p></o:p>
This is done by the below Macro :-<o:p></o:p>
<o:p> </o:p>
Code: 
[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Range("B" & i).Value >= 0 And Range("B" & i).Value <= 9 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 36<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Range("B" & i).Value >= 10 And Range("B" & i).Value <= 14 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 4<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Range("B" & i).Value >= 15 And Range("B" & i).Value < 20 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 44<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]If Range("B" & i).Value >= 20 And Range("B" & i).Value < 100 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 3<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Range("B1:B" & LastRow).Select[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]
<o:p></o:p>
<o:p> </o:p>
After colouring it does the total & Count of Column J (different totals for different groups). The macro part is below :-<o:p></o:p>
<o:p> </o:p>
Code: 
[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Dim LR As Long<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    Dim Area As Range<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]    With ActiveSheet<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]        LR = .Range("J" & .Rows.Count).End(xlUp).Row<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]        If LR = 2 Then<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            .Range("J4").Formula = "=SUM(J2)"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]        Else<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]            For Each Area In .Range("J2:J" & LR).SpecialCells(xlCellTypeConstants).Areas<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                With Area.Resize(1).Offset(Area.Rows.Count + 1)<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                    .Formula = "=SUM(" & Area.Address & ")"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                    .Offset(0, 1).Formula = "=COUNT(" & Area.Address & ")"<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]                    .Offset(0, 1).Font.ColorIndex = 2<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]<o:p>
</o:p><o:p> </o:p>
<o:p> </o:p>
<o:p> </o:p>
<o:p> </o:p>
I want the macro to insert an “a” in the Column A of the row where it does the total of 0-9 days (one in light yellow)
“b” in the row where it does a total of 10-14 days (light green)
“c” in the row where it does the total of 15-19 days (Gold)
“d” in the row where it does the total of 20 days & above (Red)
<o:p> </o:p>
We have two ways how this can be done. When the macro insert the 3 blank rows after coloring it can add the above a,b,c or d (as the case is) in the 2<SUP>nd</SUP> blank row (as that would be the row where the total would appear)
<o:p> </o:p>
Or simply we can create another macro where if the row colour is Light yellow it should add an “a” in the 2<SUP>nd</SUP> row Column A
“b” in the 2<SUP>nd</SUP> blank row after light green
“c” in the 2<SUP>nd</SUP> blank row after Gold
“d” in the 2<SUP>nd</SUP> blank row after Red
 
Upvote 0
I wish you'd just answered the question I asked; "So on which cell's colour/value does the cell in column A of the totals row depend?".
After setting up a sheet and running the macro I'm fairly sure the answer is: on any cell in column B in the section above the total row.
So I chose to use the top cell in that section to determine a,b,c or d and the colour of the top cell in column J of that section to determine the colour.
Code: 
Sub d_CellColor_and_Total_in_all_sheets_COUNT()
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
    ws.Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B1:B" & LastRow).Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                   DataOption1:=xlSortNormal
    For i = LastRow To 1 Step -1
        If Range("B" & i).Value >= 0 And Range("B" & i).Value <= 9 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 36
        If Range("B" & i).Value >= 10 And Range("B" & i).Value <= 14 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 4
        If Range("B" & i).Value >= 15 And Range("B" & i).Value < 20 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 44
        If Range("B" & i).Value >= 20 And Range("B" & i).Value < 100 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 3
        'unlikely to need following lines as the range is already sorted:
        '    Range("B1:B" & LastRow).Select
        '    Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
             '                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
             '                   DataOption1:=xlSortNormal
    Next i
    k = 3
    For j = LastRow To 1 Step -1
        If Range("B" & j).Interior.Color <> Range("B" & j + 1).Interior.Color Then
            Range("B" & j + 1).Select
            For l = 1 To k
                Selection.EntireRow.Insert
                Selection.EntireRow.Clear
            Next l
        End If
    Next j
    Range("2:4").Select
    Selection.Delete Shift:=xltoup

    Dim LR As Long
    Dim Area As Range
    With ActiveSheet
        LR = .Range("J" & .Rows.Count).End(xlUp).Row
        If LR = 2 Then
            .Range("J4").Formula = "=SUM(J2)"
            .Range("K4").Formula = "=COUNT(J2)"
            .Range("K4").Font.ColorIndex = 2
            'I'm guessing that B2 is the right cell to look at:
 [COLOR=Red]           .Range("A4").Value = Choose(Application.Match(.Range("B2").Value, Array(0, 10, 15, 20), 1), "a", "b", "c", "d")
            .Range("A4").Interior.ColorIndex = .Range("B2").Interior.ColorIndex[/COLOR]
        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
                  [COLOR=Red]  ActiveSheet.Cells(.Row, "A").Interior.ColorIndex = Area.Resize(1).Interior.ColorIndex
                    ActiveSheet.Cells(.Row, "A").Value = Choose(Application.Match(ActiveSheet.Cells(Area.Resize(1).Row, "B").Value, Array(0, 10, 15, 20), 1), "a", "b", "c", "d")[/COLOR]
                End With
            Next Area
        End If
    End With
Next
End Sub
 
Upvote 0
Thanks p45cal...
The macro you provided is working as desired. Just a few things want your help on..
1. The Value a,b,c,d cell is also coloured as red, yellow, green etc. Can there be no colour for cell & white color for font for where a,b,c,d appears.
2. This macros gives a Run time error-13 incase any of the sheet is empty & if we debug it highlights the below line:-

Code: 
.Range("A4").Value = Choose(Application.Match(.Range("B2").Value, Array(0, 10, 15, 20), 1), "a", "b", "c", "d")
Can we add something so that it ignores the blank sheets(please note the sheets still has a Header row but nothing else.)
 
Upvote 0
1.Add two lines:
Code: 
Dim ws As Object
For Each ws In Worksheets
    ws.Select
   [COLOR=Blue] If Application.WorksheetFunction.CountA(Range("A2:J20")) > 0 Then[/COLOR]
        LastRow = Cells(Rows.Count, 1).End(xlUp).Row
        
        'the rest of your code
        
  [COLOR=Red]  [COLOR=Blue]End If[/COLOR][/COLOR]
Next
2. Change Interior to Font in two places along with a few other changes:
a).
Code: 
ActiveSheet.Cells(.Row, "A").[B]Interior[/B].ColorIndex = Area.Resize(1).Interior.ColorIndex
becomes:
Code: 
ActiveSheet.Cells(.Row, "A").[COLOR=Red]Font[/COLOR].ColorIndex = [COLOR=Red]2[/COLOR]
b).
Code: 
.Range("A4").[B]Interior[/B].ColorIndex = .Range("B2").Interior.ColorIndex
becomes:
Code: 
.Range("A4").[COLOR=Red]Font[/COLOR].ColorIndex = [COLOR=Red]2[/COLOR]
 
Upvote 0
Thanks for the reply p45cal.

I am not so fimiliar with VBA. I tried combining all macro but it gives me an error duplicate compilation....

Can you please add the relevant coding. I am using the below macro.

Code: 
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
    ws.Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B1:B" & LastRow).Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                   DataOption1:=xlSortNormal
    For i = LastRow To 1 Step -1
        If Range("B" & i).Value >= 0 And Range("B" & i).Value <= 9 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 36
        If Range("B" & i).Value >= 10 And Range("B" & i).Value <= 14 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 4
        If Range("B" & i).Value >= 15 And Range("B" & i).Value < 20 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 44
        If Range("B" & i).Value >= 20 And Range("B" & i).Value < 100 Then Range(("A" & i), Range("P" & i)).Interior.ColorIndex = 3
        'unlikely to need following lines as the range is already sorted:
        '    Range("B1:B" & LastRow).Select
        '    Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
             '                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
             '                   DataOption1:=xlSortNormal
    Next i
    k = 3
    For j = LastRow To 1 Step -1
        If Range("B" & j).Interior.Color <> Range("B" & j + 1).Interior.Color Then
            Range("B" & j + 1).Select
            For l = 1 To k
                Selection.EntireRow.Insert
                Selection.EntireRow.Clear
            Next l
        End If
    Next j
    Range("2:4").Select
    Selection.Delete Shift:=xltoup

    Dim LR As Long
    Dim Area As Range
    With ActiveSheet
        LR = .Range("J" & .Rows.Count).End(xlUp).Row
        If LR = 2 Then
            .Range("J4").Formula = "=SUM(J2)"
            .Range("K4").Formula = "=COUNT(K2)"
            .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").Interior.ColorIndex = .Range("B2").Interior.ColorIndex
        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
                    ActiveSheet.Cells(.Row, "A").Interior.ColorIndex = Area.Resize(1).Interior.ColorIndex
                    ActiveSheet.Cells(.Row, "A").Value = Choose(Application.Match(ActiveSheet.Cells(Area.Resize(1).Row, "B").Value, Array(0, 10, 15, 20), 1), "a", "b", "c", "d")
                
                         
                End With
            Next Area
        End If
    End With
Next
End Sub

Appreciate your help...!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
COUNT multiple SUM COUNTIFS
Replies
6
Views
337
Peter_SSs
Peter_SSs
E
  • Solved
changing (and understand) the inside of a formula with a macro
Replies
5
Views
195
myall_blues
myall_blues
P
  • Solved
Counting number of cells with formula returning a value OR a #DIV/0 error?
Replies
3
Views
209
Eric W
Eric W
B
  • Solved
how to use find formula in a countif formula
Replies
5
Views
55
etaf
etaf
M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
330
kvsrinivasamurthy
K

Forum statistics

Threads
1,224,583
Messages
6,179,673
Members
452,937
Latest member
Bhg1984

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top