• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1618
  • Last Modified:

VBA Delete rows if they do not contain...

Ok another dumb question, but I have to ask, I have a worksheet, in the sheet can be up to 65000 lines of text, I need to go through the text to refine it. In column L starting on Row 2 I need it to delete every row that does not contain the numbers:

13 20 21 22 23 24 27 28 91 92 93 94 95 and this list could grow later down the road so I would like to be able to simply add a number to it if needed.

Problem i am having is the column contains i.e.

Crtn Shortage-Freight Bill Signed Short [24]
Merchandise Billed Not Shipped [22]

So I would need the VBA code to look in this column, and see that there is [22] or [24] or any of the numbers I had listed, if those numbers are in the string, then delete the row, and move on to the next row.

Is there a simple way I can do this?
1 Solution
Patrick MatthewsCommented:
The following sub uses Regular Expressions to look for the number code, and tries to find it in a constant
that contains all the 'allowed' codes. If not found, the row is deleted.

Sub KillThem()
    Dim LastR As Long
    Dim Counter As Long
    Dim TestStr As String
    Dim TestRes As String
    Const Allow As String = "[13][20][21][22]" 'add as needed
    With ActiveSheet
        LastR = .Cells(.Rows.Count, "L").End(xlUp).Row
        For Counter = LastR To 2 Step -1
            TestStr = .Cells(Counter, "L")
            TestRes = RegExpFind(TestStr, "\[\d+\]", 1)
            If InStr(1, Allow, TestRes) = 0 Then .Rows(Counter).Delete
    End With
    MsgBox "Done"
End Sub
Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _
    Optional MatchCase As Boolean = True) 
    ' For more info see: http://vbaexpress.com/kb/getarticle.php?kb_id=841 
    ' This function uses Regular Expressions to parse a string (LookIn), and return matches to a
    ' pattern (PatternStr).  Use Pos to indicate which match you want:
    ' Pos omitted               : function returns a zero-based array of all matches
    ' Pos = 0                   : the last match
    ' Pos = 1                   : the first match
    ' Pos = 2                   : the second match
    ' Pos = <positive integer>  : the Nth match
    ' If Pos is greater than the number of matches, is negative, or is non-numeric, the function
    ' returns an empty string.  If no match is found, the function returns an empty string
    ' If MatchCase is omitted or True (default for RegExp) then the Pattern must match case (and
    ' thus you may have to use [a-zA-Z] instead of just [a-z] or [A-Z]).
    ' If you use this function in Excel, you can use range references for any of the arguments.
    ' If you use this in Excel and return the full array, make sure to set up the formula as an
    ' array formula.  If you need the array formula to go down a column, use TRANSPOSE()
    Static RegX As Object
    Dim TheMatches As Object
    Dim Answer() As String
    Dim Counter As Long
    ' Evaluate Pos.  If it is there, it must be numeric and converted to Long
    If Not IsMissing(Pos) Then
        If Not IsNumeric(Pos) Then
            RegExpFind = ""
            Exit Function
            Pos = CLng(Pos)
        End If
    End If
    ' Create instance of RegExp object
    If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = PatternStr
        .Global = True
        .IgnoreCase = Not MatchCase
    End With
    ' Test to see if there are any matches
    If RegX.test(LookIn) Then
        ' Run RegExp to get the matches, which are returned as a zero-based collection
        Set TheMatches = RegX.Execute(LookIn)
        ' If Pos is missing, user wants array of all matches.  Build it and assign it as the
        ' function's return value
        If IsMissing(Pos) Then
            ReDim Answer(0 To TheMatches.Count - 1) As String
            For Counter = 0 To UBound(Answer)
                Answer(Counter) = TheMatches(Counter)
            RegExpFind = Answer
        ' User wanted the Nth match (or last match, if Pos = 0).  Get the Nth value, if possible
            Select Case Pos
                Case 0                          ' Last match
                    RegExpFind = TheMatches(TheMatches.Count - 1)
                Case 1 To TheMatches.Count      ' Nth match
                    RegExpFind = TheMatches(Pos - 1)
                Case Else                       ' Invalid item number
                    RegExpFind = ""
            End Select
        End If
    ' If there are no matches, return empty string
        RegExpFind = ""
    End If
    ' Release object variables
    Set TheMatches = Nothing
End Function

Open in new window


Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Tackle projects and never again get stuck behind a technical roadblock.
Join Now