Sort an Delete rows using a Macro

[monkeyharris]

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

 

[NewOrderFac33]

Try this:

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]

Without looping and changes in blue, try:

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]

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]

MonkeyHarris,

Did you change

Set MyRange = Range("E1:E1000")

to:

Set MyRange = Range("E2:E1000")
[/COLOR]

?

Pete

 

[JackDanIce]

Change in blue, try:

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

 

[monkeyharris]

Guys, I can't thank you enough, this works Perfectly.

 

[JackDanIce]

Glad it helps