Sort an Delete rows using a Macro

monkeyharris

Active Member
Joined
Jan 20, 2008
Messages
310
Hi, I have a Macro which sorts and deletes rows based on one criteria but now i need to sort Column E then delete all Rows which DON'T say the work "CPI". Is this possible. I can do it so it will delete anything which =CPI but the <>CPI method won't work. PLEASE HELP. This is the Macro:

Sub M1()


Dim LR As Long, LC As Long


Application.ScreenUpdating = False


With ActiveSheet
LR = .Range("L" & .Rows.Count).End(xlUp).Row
LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
If .AutoFilterMode Then .AutoFilterMode = False
With .Range("A1").Resize(LR, LC)
.Sort key1:=ActiveSheet.Range("E1"), order1:=xlAscending, Header:=xlYes
.AutoFilter
.AutoFilter field:=ActiveSheet.Range("E1").Column, Criteria1:=CPI
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With


Application.ScreenUpdating = True


End Sub
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,252
Try this:
Code:
Sub DeleteRowsThatDontEqualCPI()
        
    Dim MyRange As Range
    Dim MyTotal As Long
    
    Set MyRange = Range("E1:E1000")
    MyTotal = MyRange.Cells.Count
    
    For MyCount = MyTotal To 1 Step -1
        If MyRange.Cells(MyCount) <> "CPI" Then
             MyRange.Cells(MyCount).EntireRow.Delete
        End If
    Next
    
End Sub

You have to delete rows from the bottom to the top of the worksheet, otherwise it doesn't work. Just change the reference in MyRange to suit your needs.

Hope this helps

Pete
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,685
Office Version
  1. 365
Platform
  1. Windows
Without looping and changes in blue, try:
Rich (BB code):
Sub M1()

Dim rng As Range
Dim LR As Long, LC As Long

Application.ScreenUpdating = False

With ActiveSheet
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    If .AutoFilterMode Then .AutoFilterMode = False
    With .Range("A1").Resize(LR, LC)
        .Sort key1:=ActiveSheet.Range("E1"), order1:=xlAscending, Header:=xlYes
        .AutoFilter
        .AutoFilter field:=ActiveSheet.Range("E1").Column, Criteria1:="<>CPI"
        .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   End With
   If .FilterMode Then .ShowAllData
   .AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub
 

monkeyharris

Active Member
Joined
Jan 20, 2008
Messages
310
Hi Pete & Dan,

They both work to a degree but there is one problem with both. Dan, yours does everything but leaves the cell border where the deleted cells were. Pete, yours deleted all the lines OK but also deleted the first line which also contains the headings.
 

NewOrderFac33

Well-known Member
Joined
Sep 26, 2011
Messages
1,252

ADVERTISEMENT

MonkeyHarris,

Did you change
Code:
Set MyRange = Range("E1:E1000")
to:
Code:
Set MyRange = Range("E2:E1000")
[/COLOR]


? :)

Pete
 
Last edited:

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,685
Office Version
  1. 365
Platform
  1. Windows
Change in blue, try:
Rich (BB code):
Sub M1()

Dim LR As Long, LC As Long

Application.ScreenUpdating = False

With ActiveSheet
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    If .AutoFilterMode Then .AutoFilterMode = False
    With .Range("A1").Resize(LR, LC)
        .Sort key1:=ActiveSheet.Range("E1"), order1:=xlAscending, Header:=xlYes
        .AutoFilter
        .AutoFilter field:=ActiveSheet.Range("E1").Column, Criteria1:="<>CPI"
        With .Offset(1).SpecialCells(xlCellTypeVisible)
            .Borders.LineStyle = xlNone
            .EntireRow.Delete
        End With
   End With
   If .FilterMode Then .ShowAllData
   .AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,461
Messages
5,528,939
Members
409,848
Latest member
Blomsten
Top