Deleting lines in sheet based on text in one column in VBA

55 Views Asked by At

I currently have a macro set to delete lines I no longer need as a start:

Sub JSAidRun()
'
' JSAidRun Macro
'

'
Range("1:1,2:2").Select
Range("A2").Activate
Selection.Delete Shift:=xlUp
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
Range("AP:AP,AO:AO,AM:AM").Select
Range("AM1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range("AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ").Select
Range("AJ1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range("AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG").Select
Range("AG1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range("AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD").Select
Range("AD1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA" _
    ).Select
Range("AA1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X" _
    ).Select
Range("X1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U" _
    ).Select
Range("U1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R" _
    ).Select
Range("R1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O" _
    ).Select
Range("O1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O,N:N,M:M,L:L" _
    ).Select
Range("L1").Activate
ActiveWindow.SmallScroll ToRight:=-3
Range( _
    "AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O,N:N,M:M,L:L,K:K,J:J,I:I" _
    ).Select
Range("I1").Activate
ActiveWindow.SmallScroll ToRight:=-2
Union(Range( _
    "G:G,AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O,N:N,M:M,L:L,K:K,J:J,I:I" _
    ), Columns("H:H")).Select
Range("G1").Activate
ActiveWindow.SmallScroll ToRight:=-4
Union(Range( _
    "G:G,E:E,AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O,N:N,M:M,L:L,K:K,J:J" _
    ), Range("I:I,H:H")).Select
Range("E1").Activate
ActiveWindow.SmallScroll ToRight:=-2
Union(Range( _
        "G:G,E:E,D:D,B:B,AP:AP,AO:AO,AM:AM,AL:AL,AJ:AJ,AI:AI,AH:AH,AG:AG,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X    ,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O,N:N,M:M,L:L" _
    ), Range("K:K,J:J,I:I,H:H")).Select
Range("B1").Activate
Selection.Delete Shift:=xlToLeft
Range("C4").Select
Columns("B:B").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 71.43
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Rows("1:1").Select
Selection.AutoFilter


End Sub

It's working nicely to pare down the amount of data from a report I get.

Now I need to delete more data after this. I am left with columns A-F, which is perfect. In column D, I need VBA to search for "Suspended", "Not Posted", "In Progress", "Expired", "Scheduled", "Unposted"...and then automatically delete any rows which contain that data.

I need this to all be run under a singular command if possible. I only want to run one macro.

Please help me.

I tried this as a start:

Sub DeleteRowswithSpecificText()
For i = Selection.Rows.Count To 1 Step -1
If Cells(i, 4).Value = "Suspended" Then
Cells(i, 4).EntireRow.Delete
End If
Next i
End Sub

but nothing happens

1

There are 1 best solutions below

2
Gustavo Monteiro Reis On

A little change on your code. Try this:

Sub DeleteRowswithSpecificText()
    '******************************************************
    ' Alert: it will looping all cells from the column "D".
    ' It's a good idea define the range just you'll use.
    '******************************************************

    ' Disable time waster
    Application.ScreenUpdating = False
    
    Dim Line As Range
    
    For Each Line In ActiveSheet.Columns.Range("D:D")
        
        ' Searching values
        Select Case Line.Value2
            
            ' Deleting row
            Case "Suspended", "Not Posted", "In Progress"
                Line.EntireRow.Delete
            
            ' Maybe you just want to change the cell background color
            Case "Expired", "Scheduled", "In Unposted"
                ' Change cell color
                Line.Interior.color = RGB(240, 107, 89) 'Red - Dec: 15756121
                
                ' Change entire row color
                Line.EntireRow.Interior.color = RGB(240, 107, 89) 'Red - Dec: 15756121
                
        End Select
    Next
    
    Application.ScreenUpdating = True
    
End Sub