Macro to delete rows based on criteria

L

Legacy 388346

Guest
Hi, Can anyone help me out with this please?
First In the column with status, any records that are not released should be deleted.
Then in the external document column, any records that contain DDS, MIN, or Canada should be deleted. I say contain because it could be either DDS by itself, or with numbers after it, or min or minimum order, etc. Finally it should be re-sorted by the days column which is column B off screen so that there are no blank rows in between the remaining cells. Please and thanks in advance for your help.
2iblsac.jpg
[/IMG]




mlgvhu.jpg
[/IMG]
 
Last edited by a moderator:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
Re: Need help with macro to delete rows based on criteria

Try this:
Code: 
Sub aireanna()
Dim lrow As Long
Dim lcolumn As Long
Dim i As Long

lcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lrow To 2 Step -1
    If Cells(i, 13) <> "Released" Then
        Rows(i).Delete
    Else
        If InStr(UCase(Cells(i, 17)), "DDS") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "MIN") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "CANADA") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
    End If
Nexti:
Next i

Range(Cells(1, 1), Cells(lrow, lcolumn)).Sort Key1:=Range("B1:B" & lrow), Order1:=xlAscending, Header:=xlYes
End Sub
 
Upvote 0
Try:
Code: 
Sub M1()
    
    Dim x   As Long
    Dim y   As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        y = .Cells(1, .Columns.count).End(xlToLeft).column
        x = .Cells(.Rows.count, 13).End(xlUp).row
        With .Cells(1, 13).Resize(x, 5)
            .AutoFilter Field:=1, Criteria1:="<>Released"
            .Offset(1).Resize(x - 1).EntireRow.Delete
            .Parent.ShowAllData
            .AutoFilter Field:=5, Criteria1:=Array("DDS*", "MIN*","Canada"), Operator:=xlFilterValues
            .Offset(1).Resize(x - 1).EntireRow.Delete
            .Parent.AutoFilterMode = False
        End With
        
        x = .Cells(.Rows.count, 2).End(xlUp).row
        .Cells(1, 1).Resize(x, y).Sort key1:=.Cells(2, 1), order1:=xlAscending, header:=xlYes
    End With
        
    Application.ScreenUpdating = True

End Sub
 
Last edited:
Upvote 0
Re: Need help with macro to delete rows based on criteria

Max1616 said:
Try this:
Code: 
Sub aireanna()
Dim lrow As Long
Dim lcolumn As Long
Dim i As Long

lcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lrow To 2 Step -1
    If Cells(i, 13) <> "Released" Then
        Rows(i).Delete
    Else
        If InStr(UCase(Cells(i, 17)), "DDS") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "MIN") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "CANADA") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
    End If
Nexti:
Next i

Range(Cells(1, 1), Cells(lrow, lcolumn)).Sort Key1:=Range("B1:B" & lrow), Order1:=xlAscending, Header:=xlYes
End Sub
Click to expand...

Hi, This worked perfect thank you. I forgot one thing though. There is another column called Backorder Amount I need to also delete any rows with a qty of 0. This is is column AB. Could I beg you to modify this macro to also include that?
Thank you so much, you are saving me hours of work.
 
Upvote 0
Re: Need help with macro to delete rows based on criteria

Here you go:
Code: 
Sub aireanna()
Dim lrow As Long
Dim lcolumn As Long
Dim i As Long

lcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lrow To 2 Step -1
    If Cells(i, 13) <> "Released" Then
        Rows(i).Delete
    Else
        If InStr(UCase(Cells(i, 17)), "DDS") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "MIN") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "CANADA") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If Cells(i, 28) = 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
    
    End If
Nexti:
Next i

Range(Cells(1, 1), Cells(lrow, lcolumn)).Sort Key1:=Range("B1:B" & lrow), Order1:=xlAscending, Header:=xlYes
End Sub
 
Upvote 0
Re: Need help with macro to delete rows based on criteria

Max1616 said:
Here you go:
Code: 
Sub aireanna()
Dim lrow As Long
Dim lcolumn As Long
Dim i As Long

lcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
lrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lrow To 2 Step -1
    If Cells(i, 13) <> "Released" Then
        Rows(i).Delete
    Else
        If InStr(UCase(Cells(i, 17)), "DDS") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "MIN") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If InStr(UCase(Cells(i, 17)), "CANADA") <> 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
        If Cells(i, 28) = 0 Then
            Rows(i).Delete
            GoTo Nexti
        End If
    
    End If
Nexti:
Next i

Range(Cells(1, 1), Cells(lrow, lcolumn)).Sort Key1:=Range("B1:B" & lrow), Order1:=xlAscending, Header:=xlYes
End Sub
Click to expand...

Thank you so much!! you are the greatest!!!
 
Upvote 0
Re: Need help with macro to delete rows based on criteria

Hi, so this report has changed because I had to add another column which shifted all the other columns.
I tried to change it but could not get it to work correctly. Here is the layout of the new columns.

b8mrd5.jpg
[/IMG]
Also prior to this step I am trying to create a macro to shift the columns around to the layout I need. There is one column named customer that is a vlookup that pulls from a tab in sheet and is named Tier List and uses column formula is VLOOKUP(H2,'Tier List '!B:C,2,FALSE) H2 is the variable data to search match to , and the other named days is a 360 formula that calculates the number of days between the order date in column A and today. Because the # of rows change each time i run report, I cant just copy the formula down in the macro. Below is my macro I created so far. Thanks in advance:)
Sub bko_step1()
'
' bko_step1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Cells.Select
With Selection.Font
.Name = "Calibri"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Calibri"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("E:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AM:AM").Select
Selection.Cut Destination:=Columns("E:E")
Columns("AJ:AK").Select
Selection.Cut Destination:=Columns("F:G")
Range("H1").Select
ActiveCell.FormulaR1C1 = "Customer"
Columns("R:S").Select
Selection.Cut Destination:=Columns("I:J")
Columns("U:U").Select
Selection.Cut Destination:=Columns("K:K")
Columns("T:T").Select
Selection.Cut Destination:=Columns("L:L")
Columns("R:U").Select
Selection.Delete Shift:=xlToLeft
Columns("AF:AG").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
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 = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = "Days"
Range("B7").Select
End Sub
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Macro to delete row based on cell criteria
Replies
3
Views
160
MPFX2022
M
R
  • Solved
How to delete row based on cell value?
Replies
5
Views
221
Peter_SSs
Peter_SSs
D
  • Question Question
Creating a Macro/Script where it automatically deletes All Rows With a Blank Cell
Replies
4
Views
215
Joe4
Joe4
R
  • Solved
Textsplit & Concatenate from one column to another / multiple rows.
Replies
5
Views
133
kvsrinivasamurthy
K
M
  • Solved
Deleting rows from a Range variable
Replies
4
Views
365
Umma123
U

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,021
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top