Delete row Content specific

[manoj_arsul]

I have the below program for delete row if specific value content in column . but it getting too much time for running .

I want to run the same program but take less time.

Also help me for the run that program for different sheet (Sheet2)



Sub DeleteRowContents()

last = Cells(Rows.Count, "G").End(xlUp).Row
For i = last To 1 Step -1
If (Cells(i, "G").Value) = "ABCD" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
For i = last To 1 Step -1
If (Cells(i, "G").Value) = "XYZ" Then
' Cells(i, "A").EntireRow.Delete
End If
Next i
For i = last To 1 Step -1
If (Cells(i, "G").Value) = "PQR" Then
Cells(i, "A").EntireRow.Delete
End If

Next i

End Sub

 

[My Aswer Is This]

Try this:

Sub Filter_Me_OK()
'Modified 7/4718 6:40 AM EDT
Dim Lastrow As Long
Dim c As Long
Dim Counter As Long
c = 7 ' Column Number Modify this to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row

With ActiveSheet.Cells(1, c).Resize(Lastrow)
    .AutoFilter Field:=1, Criteria1:=Array("ABCD", "XYZ", "PQR"), Operator:=xlFilterValues
    Counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If Counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
End Sub

Run this script on the sheet with your data

 

[hiker95]

manoj_arsul,

What are the worksheet names that you want the macro to run in?

 

[manoj_arsul]

Try this:

Sub Filter_Me_OK()
'Modified 7/4718 6:40 AM EDT
Dim Lastrow As Long
Dim c As Long
Dim Counter As Long
c = 7 ' Column Number Modify this to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row

With ActiveSheet.Cells(1, c).Resize(Lastrow)
    .AutoFilter Field:=1, Criteria1:=Array("ABCD", "XYZ", "PQR"), Operator:=xlFilterValues
    Counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If Counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
End Sub

Run this script on the sheet with your data

@My Aswer Is This : Thank you !! Its working for me .

Can you please send me program for the below condition .

in the same column ( Column - G) delete the rows if string is having words like below ( Delete all the rows content ABCD , XYZ, PQR )
1 . sadsd ABCD addwqewq
2 ewdewe PQR adadadsd
3 . XYZ wdeweq eewwqeq safd
4 . wewqe ERASD EWQE xyz
5. PQR ewer sewe

 

[My Aswer Is This]

I provided the answer to the question you asked.
The request you have now is:
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.

 

[hiker95]

in the same column ( Column - G) delete the rows if string is having words like below ( Delete all the rows content ABCD , XYZ, PQR )
1 . sadsd ABCD addwqewq
2 ewdewe PQR adadadsd
3 . XYZ wdeweq eewwqeq safd
4 . wewqe ERASD EWQE xyz
5. PQR ewer sewe

manoj_arsul,

It is always easier to help and test possible solutions if we could work with your actual file.

Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com.

Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Include a detailed explanation of what you would like to do referring to specific cells and worksheets.

If the workbook contains confidential information, you could replace it with generic data.

 

[My Aswer Is This]

Try this on active sheet:

'Modified 7/7/18 10:10 AM EDT
Dim Lastrow As Long
Dim c As Long
Dim Counter As Long
c = 7 ' Column Number Modify this to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row
Dim Del As Variant
Del = Array("ABCD", "XYZ", "PQR")
ans = UBound(Del)
    For i = 1 To ans + 1
    
        With ActiveSheet.Cells(1, c).Resize(Lastrow)
            .AutoFilter 1, "*" & Del(i - 1) & "*"
            Counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
            If Counter > 1 Then
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            Else
                MsgBox "No values found"
            End If
                .AutoFilter
        End With
    Next
End Sub

 

[JackDanIce]

Since you can pass an array of values to filter for as part of the criteria, you can avoid looping and execute in single pass. As alt suggestion, try:

Sub Macro1()

Dim x                 As Long
Dim ColToFilter As Long

Application.ScreenUpdating = False

With ActiveSheet
    If .AutoFilterMode Then .AutoFilterMode = Fals
    
    ColToFilter = 7 'Adjust for whatever column index number you wish to filter
    
    x = .Cells(.Rows.Count, ColToFilter).End(xlUp).Row

    With .Cells(1, ColToFilter).Resize(x)
        .AutoFilter field:=1, Criteria1:=Array("ABC", "DEF", "XYZ"), Operator:=xlFilterValues
        On Error Resume Next
       .Offset(1).Resize(x - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
       On Error GoTo 0
    End With

End With

Application.ScreenUpdating = True

End Sub