Subtotal vba

[Shazam]

Hi everyone,

The code below works like a subtotal function. I would like to incorporate this formula:

=SUMPRODUCT(--(SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22)>0),SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22))

into the vba code below. I don’t know how to modify it. I left a very small example workbook below.



Sub AutoSum()

For Each NumRange In Columns("B").SpecialCells(xlCellTypeConstants, _
xlTextValues + xlErrors + xlLogical + xlNumbers).Areas
SumAddr = NumRange.Address(False, False)
NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"

c = NumRange.Count
Next NumRange

NoData:

End Sub

[Erdin? E. Ka]

Hi Shazam,

I think that the best way is using Evaluate:


Sub Eva()
[C23] = Evaluate("=SUMPRODUCT(--(SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22)>0),SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22))")
[C32] = Evaluate("=SUMPRODUCT(--(SUMIF(A24:A31,IF(FREQUENCY(A24:A31,A24:A31),A24:A31),B24:B31)>0),SUMIF(A24:A31,IF(FREQUENCY(A24:A31,A24:A31),A24:A31),B24:B31))")
[C45] = Evaluate("=SUMPRODUCT(--(SUMIF(A33:A44,IF(FREQUENCY(A33:A44,A33:A44),A33:A44),B33:B44)>0),SUMIF(A33:A44,IF(FREQUENCY(A33:A44,A33:A44),A33:A44),B33:B44))")
[C61] = Evaluate("=SUMPRODUCT(--(SUMIF(A46:A60,IF(FREQUENCY(A46:A60,A46:A60),A46:A60),B46:B60)>0),SUMIF(A46:A60,IF(FREQUENCY(A46:A60,A46:A60),A46:A60),B46:B60))")
End Sub

[Shazam]

Hi Shazam,

I think that the best way is using Evaluate:


Sub Eva()
[C23] = Evaluate("=SUMPRODUCT(--(SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22)>0),SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22))")
[C32] = Evaluate("=SUMPRODUCT(--(SUMIF(A24:A31,IF(FREQUENCY(A24:A31,A24:A31),A24:A31),B24:B31)>0),SUMIF(A24:A31,IF(FREQUENCY(A24:A31,A24:A31),A24:A31),B24:B31))")
[C45] = Evaluate("=SUMPRODUCT(--(SUMIF(A33:A44,IF(FREQUENCY(A33:A44,A33:A44),A33:A44),B33:B44)>0),SUMIF(A33:A44,IF(FREQUENCY(A33:A44,A33:A44),A33:A44),B33:B44))")
[C61] = Evaluate("=SUMPRODUCT(--(SUMIF(A46:A60,IF(FREQUENCY(A46:A60,A46:A60),A46:A60),B46:B60)>0),SUMIF(A46:A60,IF(FREQUENCY(A46:A60,A46:A60),A46:A60),B46:B60))")
End Sub



Hi Erdin? E. Ka,


That would work but my data fluctuates daily the ranges will varies time to time. The code I posted previous does not have that limitation. Is there way to fix that?

[makako]

Sub AutoSum()

For Each NumRange In Columns("B").SpecialCells(xlCellTypeConstants, _
xlTextValues + xlErrors + xlLogical + xlNumbers).Areas
sumaddr = NumRange.Address(False, False)
notsumaddr = NumRange.Offset(, -1).Address(False, False)
NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = _
"=SUMPRODUCT(--(SUMIF(" & notsumaddr & ",IF(FREQUENCY(" & _
notsumaddr & "," & notsumaddr & ")," & notsumaddr & ")," & _
sumaddr & ")>0),SUMIF(" & notsumaddr & ",IF(FREQUENCY(" _
& notsumaddr & "," & notsumaddr & ")," & notsumaddr & ")," _
& sumaddr & "))"
' =SUMPRODUCT(--(SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22)>0),SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22))"
c = NumRange.Count
Next NumRange

NoData:

End Sub

the thing is the first area cannot include the title.
I tried to understan whats the purpose of the formula so I cannot asure you this is your code but the results are the same as in your book

[Shazam]

Hi everyone I think I found something that may work for me. But I need some help to modify a little. I found this link below the code is originally from Bob Phillips

http://groups.google.com/group/microsoft.public.excel.programming/browse_thread/thread/45070dce4d0693f3/06bc7ce171bb8145?lnk=st&q=Countif+Subtotal+vba+excel&rnum=5&hl=en#06bc7ce171bb8145


I left a sample workbook below. I ran the code on worksheet tab "Code" But still its not giving me the correct results. The expected results I'm trying to get is on worksheet tab "Expected Resutls"

Here is the code that Bob Phillips provided.


Sub Test()
Dim iLastRow As Long
Dim iTotal As Long
Dim i As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
iTotal = iLastRow
For i = iLastRow To 2 Step -1
If Cells(i, "B").Value = "" Then
Cells(iTotal + 1, "B").Formula = _
"=SUMPRODUCT(--(SUMIF(A" & i & ":A" & iTotal & "," & _
"IF(FREQUENCY(A" & i & ":A" & iTotal & ",A" & i & ":A" & iTotal & ")" & _
",A" & i & ":A" & iTotal & "),B" & i & ":B" & iTotal & ")>0)" & _
",SUMIF(A" & i & ":A" & iTotal & ",IF(FREQUENCY(A" & i & ":A" & iTotal & "," & _
"A" & i & ":A" & iTotal & "),A" & i & ":A" & iTotal & "),B" & i & ":B" & iTotal & "))"
iTotal = i - 1
End If
Next i

End Sub

[makako]

I got the same results you did in all cases but the first area because of the title, delete the first row...

[Shazam]

Sub AutoSum()

For Each NumRange In Columns("B").SpecialCells(xlCellTypeConstants, _
xlTextValues + xlErrors + xlLogical + xlNumbers).Areas
sumaddr = NumRange.Address(False, False)
notsumaddr = NumRange.Offset(, -1).Address(False, False)
NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = _
"=SUMPRODUCT(--(SUMIF(" & notsumaddr & ",IF(FREQUENCY(" & _
notsumaddr & "," & notsumaddr & ")," & notsumaddr & ")," & _
sumaddr & ")>0),SUMIF(" & notsumaddr & ",IF(FREQUENCY(" _
& notsumaddr & "," & notsumaddr & ")," & notsumaddr & ")," _
& sumaddr & "))"
' =SUMPRODUCT(--(SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22)>0),SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22))"
c = NumRange.Count
Next NumRange

NoData:

End Sub


Hi makako,



Thank You so much for the code all the result came in correct Except for one.

Please look back in the sample workbook I provided in cell B23 it should be 4.13 but your code gives 3.41. How can we modify that?

[makako]

the title

[Bob Phillips]

Shaz,

What exactly changes, the number of cells? Is it non-contiguous data that you want to investigate, or a contiguous block.

Also, I don't get the formula, it just looks to add up all values where an adjacent coilumn is numeric to my eyes.

[Shazam]

I got the same results you did in all cases but the first area because of the title, delete the first row...


Is there way we could get around that?

[makako]

Sub AutoSum()
counter = 0
For Each NumRange In Columns("B").SpecialCells(xlCellTypeConstants, _
xlTextValues + xlErrors + xlLogical + xlNumbers).Areas
If counter = 0 Then
sumaddr = NumRange.Resize(NumRange.Count - 1).Offset(1).Address(False, False)
notsumaddr = NumRange.Resize(NumRange.Count - 1).Offset(1).Offset(, -1).Address(False, False)
counter = 1
Else
sumaddr = NumRange.Address(False, False)
notsumaddr = NumRange.Offset(, -1).Address(False, False)
End If
NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = _
"=SUMPRODUCT(--(SUMIF(" & notsumaddr & ",IF(FREQUENCY(" & _
notsumaddr & "," & notsumaddr & ")," & notsumaddr & ")," & _
sumaddr & ")>0),SUMIF(" & notsumaddr & ",IF(FREQUENCY(" _
& notsumaddr & "," & notsumaddr & ")," & notsumaddr & ")," _
& sumaddr & "))"
' =SUMPRODUCT(--(SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22)>0),SUMIF(A2:A22,IF(FREQUENCY(A2:A22,A2:A22),A2:A22),B2:B22))"
c = NumRange.Count
Next NumRange

NoData:

End Sub

[Bob Phillips]

Fine bit of code :whistle:



Sub Test()
Dim iLastRow As Long
Dim iTotal As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
iTotal = iLastRow
For i = iLastRow To 1 Step -1
If Cells(i, "B").Value = "" Or i = 1 Then
Cells(iTotal + 1, "B").Formula = _
"=SUMPRODUCT(--(SUMIF(A" & i + 1 & ":A" & iTotal & _
",IF(FREQUENCY(A" & i + 1 & ":A" & iTotal & ",A" & i + 1 & ":A" & _
iTotal & "),A" & i + 1 & ":A" & iTotal & "),B" & i + 1 & ":B" & _
iTotal & ")>0),SUMIF(A" & i + 1 & ":A" & iTotal & ",IF(FREQUENCY(A" & i + 1 _
& ":A" & iTotal & ",A" & i + 1 & ":A" & iTotal & "),A" & i + 1 & ":A" & _
iTotal & "),B" & i + 1 & ":B" & iTotal & "))"
iTotal = i - 1
End If
Next i


End Sub

[Shazam]

Thank both of you. The codes works great. Thank You!!:friends:





Shaz,

What exactly changes, the number of cells? Is it non-contiguous data that you want to investigate, or a contiguous block.

Also, I don't get the formula, it just looks to add up all values where an adjacent coilumn is numeric to my eyes.

Hi xld,



The formula is Subtotaling by day per employee greater than zero. I could'nt give the employee clock numbers on the workbook because of company policy.


Once again thank You so much!!!

[Shazam]

Fine bit of code :whistle:



Sub Test()
Dim iLastRow As Long
Dim iTotal As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
iTotal = iLastRow
For i = iLastRow To 1 Step -1
If Cells(i, "B").Value = "" Or i = 1 Then
Cells(iTotal + 1, "B").Formula = _
"=SUMPRODUCT(--(SUMIF(A" & i + 1 & ":A" & iTotal & _
",IF(FREQUENCY(A" & i + 1 & ":A" & iTotal & ",A" & i + 1 & ":A" & _
iTotal & "),A" & i + 1 & ":A" & iTotal & "),C" & i + 1 & ":C" & _
iTotal & ")>0),SUMIF(A" & i + 1 & ":A" & iTotal & ",IF(FREQUENCY(A" & i + 1 _
& ":A" & iTotal & ",A" & i + 1 & ":A" & iTotal & "),A" & i + 1 & ":A" & _
iTotal & "),C" & i + 1 & ":C" & iTotal & "))"
iTotal = i - 1
End If
Next i


End Sub





Hi xld,


Your code works great but I have one thing to ask of you. I have 2 row headers so the formula is overlaping into the second row header in the result its giving me the incorrect answer. I was thinking to change it to this:


For i = iLastRow To 1 Step -2


But obiously I'm wrong. where in the code I could modify it.

Here is a example file below.

[Bob Phillips]

Shaz,

Why have two rows of headings? Just have one with 'Total Earned' in C1 with wrap-text, and it works fine again.

[Shazam]

Shaz,

Why have two rows of headings? Just have one with 'Total Earned' in C1 with wrap-text, and it works fine again.


Good advice.:yes

Thanks xld!