CODEWITHSUNDEEP
vbaexcel
Waleed Malik
Waleed Malik

Reputation: 7

Macros to Remove Unwanted Content

I am trying to create a macro code from which I can press play from VBA and when the condition is met, it deletes the whole row. The key search that I want the code to look for is "PEDS" but the important thing to note is that PEDS has numbers which follow directly after (i.e. PEDS1234), and these numbers are almost like a variable and change.

Could you please help me with this as I am stuck on this.

The current code I had created works like a filter and does not automatically remove data. 

Option Explicit

Sub KillRows()

    Dim MyRange As Range, DelRange As Range, C As Range
    Dim MatchString As String, SearchColumn As String, ActiveColumn As String
    Dim FirstAddress As String, NullCheck As String
    Dim AC

     'Extract active column as text
    AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
    ActiveColumn = AC(0)

    SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

    On Error Resume Next
    Set MyRange = Columns(SearchColumn)
    On Error GoTo 0

     'If an invalid range is entered then exit
    If MyRange Is Nothing Then Exit Sub

    MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
    If MatchString = "" Then
        NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
        "Type Yes to do so, else code will exit", "Caution", "No")
        If NullCheck <> "Yes" Then Exit Sub
    End If

    Application.ScreenUpdating = False

     'to match the WHOLE text string
    Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
     'to match a PARTIAL text string use this line
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
     'to match the case and of a WHOLE text string
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)

    If Not C Is Nothing Then
        Set DelRange = C
        FirstAddress = C.Address
        Do
            Set C = MyRange.FindNext(C)
            Set DelRange = Union(DelRange, C)
        Loop While FirstAddress <> C.Address
    End If

     'If there are valid matches then delete the rows
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 107

Answers (1)

JvdV
JvdV

Reputation: 75870

Option Explicit

Sub KillRows()

    Dim MyRange As Range, DelRange As Range, C As Range
    Dim MatchString As String, SearchColumn As String, ActiveColumn As String
    Dim FirstAddress As String, NullCheck As String
    Dim AC

    SearchColumn = "A" 'This is a new line    
    Set MyRange = Columns(SearchColumn)
    MatchString = "PEDS"

    Application.ScreenUpdating = False

     'to match a PARTIAL text string use this line
     Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)

    If Not C Is Nothing Then
        Set DelRange = C
        FirstAddress = C.Address
        Do
            Set C = MyRange.FindNext(C)
            Set DelRange = Union(DelRange, C)
        Loop While FirstAddress <> C.Address
    End If

     'If there are valid matches then delete the rows
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

You can clean up your code even more then I did. But it's a start and should work.

BTW: Nothing wrong with google for code. It's a great way of learning. It's how I did start as well....Google is your best friend.

Upvotes: 1

Related Questions