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

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
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

I
  • Question
Move multiple rows from one table to another using conditional trigger
Replies
2
Views
483
ItsNursinTime
I
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
342
pure vito
P
B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
545
Alex Blakenburg
A
T
  • Solved
VBA code to compare 2 sheets and delete rows based on 2 criteria
2 3
Replies
25
Views
2K
Skyybot
Skyybot
B
  • Solved
Delete rows based on blank cell; then copy formula to an entire column
2
Replies
12
Views
849
Skyybot
Skyybot

Forum statistics

Threads
1,215,310
Messages
6,124,187
Members
449,147
Latest member
sweetkt327

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