Need make code faster.

Hi I have below code which have to be used in a very big sheet many rows. around 500000 or more. Its very slowly of course and also i need a code more to be sure its filtered correct, before i run the last code.- But if the codes can be so they run faster would be great. The filtering have to come in this order.

First i run below code. And that can maybe be done faster. It delete rows in different conditions and in this order,

Sub DeleteRows()
    With ActiveSheet
        .AutoFilterMode = False 'remove filter
        With .Range("A:A")
            .AutoFilter Field:=1, Criteria1:="*MR no*"
            On Error Resume Next ' for the case when there is no visible rows
            .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
    Application.Wait (Now + TimeValue("00:00:02"))
    
    With .Range("D:D")
            .AutoFilter Field:=1, Criteria1:="*Account number:*"
            On Error Resume Next ' for the case when there is no visible rows
            .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
    Application.Wait (Now + TimeValue("00:00:02"))
    
    With .Range("D:D")
            .AutoFilter Field:=1, Criteria1:="*Acct ID:*"
            On Error Resume Next ' for the case when there is no visible rows
            .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
    Application.Wait (Now + TimeValue("00:00:02"))
    
    With ActiveSheet
        .AutoFilterMode = False 'remove filter
        With .Range("J:J")
            .AutoFilter Field:=1, Criteria1:="0"
            On Error Resume Next ' for the case when there is no visible rows
            .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            On Error GoTo 0
        End With
        .AutoFilterMode = False 'remove filter
Application.DisplayAlerts = True
    End With
    Application.Wait (Now + TimeValue("00:00:02"))
    
End Sub

Here between i need a new code. It has to delete all the row, if the cell A and b and c are empty. I have found some but they did not work. So between the first and the last i need this new code. All suggestions are welcome also to put the codes together .

Finally the last code will run. Brilliant code by jindon. It merge the text in column B until next date in column a., It works perfect dont know if this can be made faster.

Here is the last code.

Sub test()
    Dim r As Range
    With Sheets("sheet1").Cells(1).CurrentRegion
        For Each r In .Columns(2).SpecialCells(4).Areas
            If r.Count > 1 Then
            r(0, 2) = Trim$(Join(Application.Transpose(r(0, 2).Resize(r.Rows.Count + 1)), ", "))
            End If
        Next
        .Columns(2).SpecialCells(4).EntireRow.Delete
    End With
End Sub

Please have a look i cant upload the sheet its very big and thats the problem So hope you can help with out this.

Thanks in advance.

Sincerely
Abjac