Delete Specific Rows

[Nomas]

Hi All,

I am looking for a macro that will delete all specified rows in a worksheet based upon what is in column A. If the row shows "Upload" (which is sorted to the top of the sheet) I want to keep it. If the row shows "No Change" I want to delete it. You can see below when I recorded the macro that It was row 5 I selected the delete all below that. It wont always be row 5, but it will be rows that say "No Change", with them sorted it should always be at the bottom.

Sub UploadSort()
'
' UploadSort Macro
'

'
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("2:2").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWorkbook.Worksheets("Item Upload Template").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Item Upload Template").AutoFilter.Sort.SortFields. _
Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Item Upload Template").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("5:5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
End Sub

 

[kpark91]

Hello,
add this snippet of code at the end of your sub.

    Dim LR As Long, i As Long
    
    LR = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = LR To 1 Step -1
        If Range("A" & i).Value = "No Change" Then
            Range("A" & i).EntireRow.Delete
        End If
    Next i

 

[Nomas]

Thanks for the quick reply, I think I put it in the wrong spot though. When I run this I get an error on Selection.Autofilter, I am assuming I am doing something wrong.





Sub UploadSort()
'
' UploadSort Macro
'

'
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("2:2").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWorkbook.Worksheets("Item Upload Template").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Item Upload Template").AutoFilter.Sort.SortFields. _
Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Item Upload Template").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim LR As Long, i As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = LR To 1 Step -1
If Range("A" & i).Value = "No Change" Then
Range("A" & i).EntireRow.Delete
End If
Next i
End Sub

 

[kpark91]

Hi, I'm not too sure what's wrong with it so try recording your macro again and appending my code at the end.

 

[Nomas]

Thanks KPark, I took your advice and it seems to be moving along but when I modified the Macro to this, it runs, but it takes a LOOOOOOOOOOONGGG time to run, as in many many minutes and still doesnt finish. Is there a way to mod this so it will sort the information and the remove it faster?

Sub UploadSort()
'
' UploadSort Macro
'

'
Sheets("Item Upload Template").Select
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim LR As Long, i As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = LR To 1 Step -1
If Range("A" & i).Value = "No Change" Then
Range("A" & i).EntireRow.Delete
End If
Next i
End Sub

 

[Trebor76]

Hi Nomas,

Yes, deleting rows upwards will take a long time for large datasets and/or complex workbooks. Which row contains your headings?

Robert

 

[Nomas]

Hey Trebor,

The rows I want to keep have the word "Upload" in column A, the rows I want to delete have "No Change" in column A. I think if there was a way to do the sort that puts the "Upload" on top which I have in the macro, and then delete from the first "No Change" down, that would be ideal. The range has a fixed length and width (BZ12000 is the max, the full is A3:BZ12000) and it will always be column A that has one of those 2 values (Upload or No Change). Thanks for the help, its much appreciated!

 

[Nomas]

Hi just wanted to bump to see if anyone had any further suggestions? I appreciate any guidance.

 

[Trebor76]

You didn't answer my question re which row(s) contain the column headings. As such, the code assumes they're in the first two rows (we need to know so the rows are hidden or elese they could be deleted):

Option Explicit
Sub Macro1()

    Dim strMyCol As String
    Dim varFilterItem As Variant
    Dim lngLastRow As Long
    Dim blnAutoCalc As Boolean
    
    strMyCol = "A" 'Column containing relevant data.  Change to suit.
    varFilterItem = "No Change" 'Can be a string or numeric. Change to suit.
    
    lngLastRow = Cells(Rows.Count, strMyCol).End(xlUp).Row
    
    With Application
        If .Calculation = xlCalculationAutomatic Then
            blnAutoCalc = True
            .Calculation = xlCalculationManual
        End If
        .ScreenUpdating = False
    End With
    
    With ActiveSheet
        .AutoFilterMode = False
        .Columns(strMyCol).AutoFilter Field:=1, Criteria1:=varFilterItem
        .Rows("1:2").EntireRow.Hidden = True 'Hide the heading rows so they're not deleted
        .Columns(strMyCol).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
        .Rows("1:2").EntireRow.Hidden = False 'Unhide heading rows.
            With Application
                If blnAutoCalc = True Then
                    .Calculation = xlCalculationAutomatic
                    .ScreenUpdating = True
                End If
            End With
        .Range(strMyCol & "2").Select
    End With

End Sub

Note, as this macro will delete rows, make sure you initially run it on a copy of your data in case the results are not as expected.

Regards,

Robert

 

[Trebor76]

Refer here for another potential solution by jonmo1.