Delete Unwanted Rows

Here you go

 Dim ptr As Long, LastRow As Long
 
 LastRow = Cells(Rows.CountLarge, "j").End(xlUp).Row
 
 With Application
    .ScreenUpdating = False
    For ptr = LastRow To 2 Step -1
       If Cells(ptr, "j") = "No Shops" Then
           Cells(ptr, "j").EntireRow.Delete
       End If
    Next
    .ScreenUpdating = True
 End With