Subtotal count

[teodormircea]

Hello

I need a vba solution for SUBTOTAL, type 3 to count all the cells for each column in a range.
the solution will be to find the last row filled and to put SUBTOTAL from the first to the last cell of the last row, so i will have a subtotal for each column in this range.
i need a SUBTOTAL, in order to apply filter also:wot

[teodormircea]

I found this solution, a little chopped is working great:

Sub SUBTOTAL()
Dim LastColumn As Integer
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
derlig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
For col = 1 To LastColumn
Cells(derlig + 1, col).Formula = "=SubTOTAL(3," & Cells(2, col).Address & ":" & Cells(derlig, col).Address & ")"
Next col
End If
End Sub

But i would like to change the type 3 to 9 to 3 columns that have the header named , X,Y,Z

[Bob Phillips]

Sub Subtotal()
Dim ColNo As Long
Dim aryFind As Variant
Dim i As Long
If WorksheetFunction.CountA(Cells) > 0 Then
aryFind = Split("X,Y,Z", ",")
For i = LBound(aryFind) To UBound(aryFind)
' Search for any entry, by searching backwards by Columns.
ColNo = 0
On Error Resume Next
ColNo = Application.Match(aryFind(i), Rows(1), 0)
On Error GoTo 0
If ColNo > 0 Then
derlig = Cells(Rows.Count, ColNo).End(xlUp).Row
Cells(derlig + 1, ColNo).Formula = _
"=SUBTOTAL(9," & Cells(2, ColNo).Resize(derlig - 1).Address & ")"
End If
Next i
End If
End Sub

[teodormircea]

Thanks,for your solution,but i wanted to keep the type 3 subtotal less column with X,Y,Z header that should have type 9 subtotal.
I have to use this 2 types of subtotals.

[Bob Phillips]

... less column with X, Y, Z ... I don't understand.

[teodormircea]

Hello again

In fact i need to apply SUBTOTAL 3 and SUBTOTAL 9 in the same time.
SUBTOTAL 3 is for all the columns , less for the columns that have the headers called (X,Y,Z) which have SUBTOTAL 9.

[Bob Phillips]

Does this do it?



Sub Subtotal()
Dim LastCol As Long
Dim ColNo As Long
Dim SubNo As Long
Dim aryFind As Variant
If WorksheetFunction.CountA(Cells) > 0 Then
LastCol = Cells(1, .Columns.Count).End(xlToLeft).Column
For ColNo = 1 To LastCol
derlig = Cells(Rows.Count, ColNo).End(xlUp).row
If Cells(1, ColNo).Value = "X" Or Cells(1, ColNo).Value = "Y" Or Cells(1, ColNo).Value = "Z" Then
SubNo = 9
Else
SubNo = 3
End If
Cells(derlig + 1, ColNo).Formula = _
"=SUBTOTAL(" & SubNo & "," & Cells(2, ColNo).Resize(derlig - 1).Address & ")"
End If
Next ColNo
End If
End Sub

[teodormircea]

YES thanks :beerchug:

[teodormircea]

Hello

Sorry to disturb you again, I've spotted a problem. Normally the SUBTOTAL is on the last row of a range. That's mean from the last cell down of the range till the last cell of the last column.Here in this macros , if i have a columns that have last cells down with blanks , the subtotal is on the last cell of columns and not on the last row of the range, the subtotal is not on the same line(last row of the range).

[teodormircea]

Is ok i' found the problem


Sub Subtotal_3_9_GND()
Dim LastCol As Integer
Dim SubNo As Long
If WorksheetFunction.CountA(Cells) > 0 Then
LastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
derlig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
For ColNo = 1 To LastCol
If Cells(1, ColNo).Value = "NBV" Or Cells(1, ColNo).Value = "GAV" Or Cells(1, ColNo).Value = "DEPREC" Then
SubNo = 9
Else
SubNo = 3
End If
Cells(derlig + 1, ColNo).Formula = _
"=SUBTOTAL(" & SubNo & "," & Cells(2, ColNo).Address & ":" & Cells(derlig, ColNo).Address & ")"
Next ColNo
End If
End Sub

[Aussiebear]

G;day teodormircea,

Glad to see that you have reached a solution here. If it is the solution that you are chasing, then please mark this thread as solved by usng the thread tools.