Modify and Enhance My Recorded Code - Delete Rows Based on Value

[Myproblem]

I searched many sites and used codes which delete Rows based on criteria. In my case those codes works, BUT it took so much time about 30 min since there is about 75 thsd rows, and that solution in not time saver.
I recorded code below and it is done in seconds. I need help to make it dynamic, VBA, since number of rows is every month larger.
Basicly, I need code which delete rows based on Column B, where walue is "R"
thx in advance

Sub DelRowsBasedOnOneCriteria()
'
' DelRowsBasedOnOneCriteria Macro
'
'
    ActiveSheet.Range("$A$1:$R$74478").AutoFilter Field:=2, Criteria1:="R"
    Rows("8733:8733").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("B1").Select
    ActiveSheet.ShowAllData
    Cells.Select
    ActiveWorkbook.Worksheets("MySheet").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("MySheet").Sort.SortFields.Add Key:=Range( _
        "A2:A74478"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MySheet").Sort
        .SetRange Range("A1:R74478")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B4").Select
End Sub

 

[wigi]

You could use the much shorter and more optimized code below:

Sub DelRowsBasedOnOneCriteria()'
' DelRowsBasedOnOneCriteria Macro
'
    Application.ScreenUpdating = False
    With Range("A1").CurrentRegion
        .AutoFilter Field:=2, Criteria1:="R"
        .Offset(1).SpecialCells(xlCellTypeVisible).ClearContents
        .AutoFilter
        .Sort .Cells(1, 1), xlAscending, Header:=xlYes
    End With
    Application.ScreenUpdating = True
End Sub

 

[Myproblem]

thx wigi,
it works great and it is more faster than other solutions.

 

[fredlo2008]

Hi,

This is a difference approach. See if it works for you. Always try it in a copy of your workbook.

Sub DelRowsBasedOnOneCriteria()

Dim lRow As Long


Application.ScreenUpdating = False


With Sheets("MySheet")
    ' assign a variable to the last row number in column "B"
    lRow = .Cells(Rows.Count, "B").End(xlUp).Row
    
    With .Range("B1:B" & lRow)
        'Replace all values "R" in column "B" with nothing
        .Replace What:="R", Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows
        'delete all cells with nothing and an error handler in case there is no blank cells
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    End With
End With


Range("A1").Select
        
Application.ScreenUpdating = True


End Sub

 

[Myproblem]

@ fredlo 2008
your proposed solution is much more consuming than wigi´s one above
thx again