SubTotal Code

[truitt20]

Hi All,

Currently I have the following code which works great at subtotaling column"D" in my sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRow As Long, WF As WorksheetFunction
Set WF = Application.WorksheetFunction
If Not Application.Intersect(Target, Range("D")) Is Nothing Then
With Sheet5
lRow = .[A1].CurrentRegion.Rows.Count + 1
.Cells(lRow, 1) = Now
.Cells(lRow, 2) = WF.Subtotal(9, Sheet4.Range("D"))
End With
End If
Set WF = Nothing
End Sub


Another question for y'all. this code works perfect, but how do I only subtotal column "d:d" based on criteria in column "AF". For example I want to subtotal "D" but only for the rows where column "AF" has <>"*JAPAN*"?

thanks

 

[firefytr]

Hi there,

Don't really have the data to test with, but you might try ...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long, ws As Worksheet, rng As String, wf As WorksheetFunction
    Set ws = Sheets("Sheet5")
    Set wf = Application.WorksheetFunction
    If Application.Intersect(Target, Me.Range("D:D")) Is Nothing Then Exit Sub
    lRow = ws.Range("A:A").Find("*", after:=ws.Cells(1, 1), _
        searchorder:=xlByRows, searchdirection:=xlPrevious)
    ws.Cells(lRow, 1) = Now
    rng = "Sheet4!D:D"
    ws.Cells(lRow, 2) = Evaluate("=SUMPRODUCT(NOT(ISNUMBER(SEARCH(" & rng & ",""JAPAN"")))*" & _
        "SUBTOTAL(9,OFFSET(" & rng & ",ROW(" & rng & ")-2,0,1,1)))")
End Sub

HTH

Regards,
Zack Barresse

Simplicity is the ultimate sophistication. What is a MS MVP? PODA
- Leonardo da Vinci