Macro or Formula to count row for which a sum is taken

[harry2908]

I am using a macro (mentioned below) which totals figures in a sheet according to days. I need a macro or a formula in a specific cell of another sheet which tells the number of rows for which that sum is taken.

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)"
        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 & ")"

Can someone please help...!!!

Thanks in Advance..!!!

 

[Tom Urtis]

Well, if LR = 2 then you already know the answer is 1.

That leaves your areas to consider. You can amend your code like so:



Else
Dim xRowsArea as Long
xRowsArea = 0

For Each Area In .Range("J2:J" & LR).SpecialCells(xlCellTypeConstants).Areas
With Area.Resize(1).Offset(Area.Rows.Count + 1)
.Formula = "=SUM(" & Area.Address & ")"
xRowsArea = xRowsArea + Area.rows.count


At the end of your loop, the xRowsArea variable will tell you how many rows. I hedge a bit on this because I don't undertsand why you are resizing your areas by increasing their row count by 1, so maybe you need
xRowsArea = xRowsArea + Area.rows.count + 1

but you get the idea.

 

[harry2908]

Hi Tom,

Thanks for your response..

I have tried doing what you mentioned above. The point is i m not so familier with VBA so i am facing trouble. I have mentioned a part of the macro above, please find the full macro below.

it would be really helpful if you can make changes in the code below & repost it...

Thanks..

Sub d_CellColor_and_Total_in_all_sheets()
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
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)"
        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 & ")"
                    
                End With
            Next Area
        End If
    End With
Next
End Sub