VBA Code to extract subtotals

I am looking for VBA code to extract the row number and sub-total in Col B in sheet 1, where the value is not zero for eg if the sub-total value is for eg 50, -50 etc., but to ignore zeroes

I would like row numbers containing the sub-total values that are not zero to be extracted to sheet2.

I have manually extracted the Row # in Col A and the value in Col B on Sheet2 to give an idea of what the extraction must look like

Your assistance in this regard is most appreciated


VBA Code to extract subtotals

HI,

The following code may help.

Code:

---

Sub Total_Extraction()
Application.ScreenUpdating = False
Dim c As Variant
Dim Ffind As Long
Dim Slrow As Long
''' Doing seach for the formula "SubTotal ''
With Sheets("Sheet1").Range("B1:B" & Sheets("Sheet1").Range("B65536").End(xlUp).Row)
    Set c = .Find("SUBTOTAL", Lookat:=xlPart)
    If Not c Is Nothing Then
        '''' get row nr and Value in cell copy to sheet2 ''
        Ffind = c.Row
        '' See if value < 0 '' if it is finish code''
        If Cells(c.Row, 2).Value < 0 Then
            Slrow = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1
            Sheets("Sheet2").Range("A" & Slrow).Value = c.Row
            Sheets("Sheet2").Range("B" & Slrow).Value = Sheets("Sheet1").Cells(c.Row, 2).Value
        End If
        Do
            Set c = .FindNext(c)
            If c.Row = Ffind Then Exit Sub
            If Cells(c.Row, 2).Value < 0 Then
            Slrow = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1
            Sheets("Sheet2").Range("A" & Slrow).Value = c.Row
            Sheets("Sheet2").Range("B" & Slrow).Value = Sheets("Sheet1").Cells(c.Row, 2).Value
        End If
        Loop While c.Row <> Ffind
    End If
End With

End Sub

---

Hi Charles

Thanks for the help, much appreciated

I made one small change , I needed to include positive and negative calues <> zero -see snippet of code below


If Cells(c.Row, 2).Value <> 0 Then ....

If Cells(c.Row, 2).Value <> 0 Then .....

Are there any good VBA books your can recommend for novices?