excel VBA module delete entire rows based on passed in condition

Posted on 2012-09-19
Last Modified: 2012-09-24
I would like a module that I can pass in a condition. In other words pass into the module the character string im looking for then delete the entire row it exists on.
Question by:lucasd1973
    LVL 13

    Expert Comment

    Sub sample()
        Dim x As String, CurrCell As Range, y As Long
        x = "sample"
         Set CurrCell = Cells.Find(What:=x, After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)
            If Not CurrCell Is Nothing Then
                 Rows(CurrCell.Row & ":" & CurrCell.Row).Select
                 Selection.Delete Shift:=xlUp
            End If
    End Sub

    Open in new window

    LVL 26

    Expert Comment

    These are two amazing references that will show you several ways to do that.
    LVL 33

    Expert Comment

    Try this.
    Sub DeleteMatch(strTerm As String)
    Dim rw As Range
    Dim rngFnd As Range
    Dim I As Long
        For I = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
            Set rw = Rows(I)
             Set rngFnd = rw.Find(What:=strTerm)
             If Not rngFnd Is Nothing Then
             End If
         Next I
    End Sub

    Open in new window

    You would call it like this.
    ' remove all rows with 'Test' in them
    DeleteMatch "Test"

    Open in new window

    LVL 18

    Accepted Solution


    Sub DeleteRows(ByRef SearchRange As Range, ByVal DeleteString)
        Dim k, i As Long, txt As String
        k = SearchRange.Value2
        If TypeOf DeleteString Is Range Then DeleteString = DeleteString.Value2
        DeleteString = LCase(DeleteString)
        Application.ScreenUpdating = 0
        With SearchRange
            For i = UBound(k, 1) To 1 Step -1
                If LCase(k(i, 1)) = DeleteString Then
                    txt = txt & ",A" & i
                    If Len(txt) > 245 Then
                        txt = Mid$(txt, 2)
                        txt = vbNullString
                    End If
                End If
            If Len(txt) > 1 Then
                .Range(Mid(txt, 2)).EntireRow.Delete
            End If
        End With
        Application.ScreenUpdating = 1
    End Sub
    Sub kTest()
        DeleteRows Range("Sheet2!A2:A10000"), "ZSP"
    End Sub

    Open in new window


    Author Comment

    Got a run-time error '1004':
    Method 'Range' of object'Global'failed
    LVL 33

    Expert Comment

    With which code?

    Featured Post

    What Is Threat Intelligence?

    Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

    Join & Write a Comment

    This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
    User Beware!  This is a rather permanent solution to removing your email from an exchange server.  The only way to truly go back is to have your exchange administrator restore your mailbox from backups.  This is usually the option of last resort.  A…
    The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
    This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

    754 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    25 Experts available now in Live!

    Get 1:1 Help Now