1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to delete rows when subtotal is equal to a certain value

Discussion in 'VBA Macros' started by Bomino, Jun 16, 2017.

  1. Bomino

    Bomino Member

    Messages:
    72
    Hello,
    I've been trying to resolve this all day without success. I've been googling too without success; and I thought most likely someone would help me here.
    I would like to delete the subtotal line and the associated rows when subtotal equals a certain value.

    Thank you.
  2. NARAYANK991

    NARAYANK991 Excel Ninja

    Messages:
    14,669
    Hi ,

    Please upload your workbook.

    Narayan
    Chirag R Raval likes this.
  3. Bomino

    Bomino Member

    Messages:
    72
    Hi, NARAYANKA991

    Please see attached sample data. Obviously my file has more 100K records.

    If subtotal is less than 250,000 then delete subtotal along with all associated rows.

    Thank you.

    Attached Files:

  4. NARAYANK991

    NARAYANK991 Excel Ninja

    Messages:
    14,669
    Hi ,

    Do you really need a macro ?

    I can describe the manual procedure to do this , and it should not take you more than a few minutes to get it done.

    Narayan
  5. Bomino

    Bomino Member

    Messages:
    72
    Narayank991,

    I will take any help I can get.

    Thank you
  6. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,601
    Hi, Bomino!

    Give a look at the uploaded file.

    This is the code:
    Code (vb):
    Option Explicit

    Sub WhyDoItManually()
        '
       ' constants
       Const ksWS = "Sheet3"
        Const klMin As Long = 250000
        '
       ' declarations
       Dim lMin As Long, iCol As Integer, lFrom As Long, lTo As Long, lPos As Long
        Dim rng As Range, cel As Range
        Dim sCel As String
        Dim I As Integer
        '
       ' start
       '  subtotal column
       Worksheets(ksWS).Activate
        Range("A1").Select
        On Error Resume Next
        Cells.Find(What:="Subtotal", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        On Error GoTo 0
        If ActiveCell.Address = "$A$1" Then Exit Sub
        Set cel = ActiveCell
        iCol = cel.Column
        lPos = 1
        '  range
       Set rng = Columns(iCol)
        '  minimum
       lMin = CLng(Val(InputBox("Enter the min value to remove groups", "Min value", klMin)))
        If lMin = 0 Then lMin = klMin
        '
       ' process
       Do
            ' position
           lFrom = cel.Row
            ' control
           If cel.Value < lMin Then
                ' subtotal formula
               sCel = cel.Formula
                ' subtotal range
               I = InStr(sCel, ",")
                Set rng = Range(Mid(sCel, I + 1, Len(sCel) - I - 1))
                With rng
                    lFrom = .Row
                    lTo = .Row + .Rows.Count
                    ' remove
                   Range(Rows(lFrom), Rows(lTo)).Delete xlShiftUp
                    ' reposition
                   Cells(lFrom - 1, iCol).Select
                    lPos = lFrom - 1
                End With
            End If
            ' next group
           On Error Resume Next
            Cells.Find(What:="Subtotal", After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate
            If Err.Number > 0 Then Exit Do
            On Error GoTo 0
            Set cel = ActiveCell
        Loop Until cel.Row < lPos
        '
       ' end
       Set rng = Nothing
        Beep
        '
    End Sub
    Regards!

    Attached Files:

  7. Bomino

    Bomino Member

    Messages:
    72
    SirJB7,

    Your code is the solution to my problem.

    Thank you so much.
  8. Bomino

    Bomino Member

    Messages:
    72
    Hi SirBJ7,

    I tested your code and I noticed that the code will execute even if I click Cancel. Am I missing something?

    Your help is very much appreciated.
  9. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,601
    Hi, Bomino!
    If you click Cancel you don't modify the default value, 250K. Change its setting to 0 won't remove anything but it'll run indeed. To avoid the execution when clicking Cancel change the default value to 0 and place an if after the input box assignation to perform an exit sub.
    Regards!
    Bomino likes this.
  10. Bomino

    Bomino Member

    Messages:
    72
    Thank you SirJB7.
  11. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,601
    Hi, Bomino!
    Hope you could solve it.
    If no, just tell us. If yes, thanks for your feedback and welcome back whenever needed or wanted.
    Regards!

Share This Page