Removal of redundant rows with loop

Question

I am a debutant in Excel VBA and have still a lot to learn. Right now, I am working on a code for removing rows from a list that are not needed. I managed so far to create a working code, but I have still some issues. One of them is that I can't get it into a loop. I get all the time an Error 91. I hope someone of you experienced guys can have a look and tell me how I can build in a loop in this, and probably other things that have to be fixed. Thanks a lot, Ron

Sub TestSBFltr3()

Dim ws As Worksheet
Dim TemP As Range
Dim DaVal As String
Dim TiVal As String
Dim PrVal As String
Dim i As Long
Dim DblRws As Integer
Dim LastRow As Long



'1.Set reference to the sheet in the workbook.
Set ws = ActiveWorkbook.Worksheets("Long Term List of Reservations")
ws.Activate 'not required but allows user to view sheet if warning message appears



'2.Clear any existing filters
On Error Resume Next
ws.ShowAllData
On Error GoTo 0


LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 3 To LastRow

    '3.Activate the Subtitle column
    ws.Rows(2).Find(What:="Subtitle", LookAt:=xlWhole, MatchCase:=True, SearchFormat:=False).Activate


Set TemP = ActiveCell

    '4.Autofilter rows with *SB subtitles
    ws.Range("A2", Range("A2").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=TemP.Column, Criteria1:="*SB"
    
    '5.Select first Date of the filtered *SB subtitle selection
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).SpecialCells(xlCellTypeVisible).Cells(1, 2).Select
       
'5.1 Set the value to variable DaVal
DaVal = ActiveCell.Value

    '6.Select the first time of the filtered *SB subtitle selection
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).SpecialCells(xlCellTypeVisible).Cells(1, 3).Select
    
'6.1 Set the value to variable TiVal
TiVal = ActiveCell.Value

    '7.Select the first program name of the filtered *SB subtitle selection
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).SpecialCells(xlCellTypeVisible).Cells(1, 4).Select
    
'7.1 Set the value to variable PrVal
PrVal = ActiveCell.Value

'8.Clear the filter for finding corresponding programs with *SB subtitles
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
    

    
    '9.Filter the list for finding the dates values corresponding with the value of Daval
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=2, Criteria1:=DaVal
   
    '10.Filter the list for finding the time values corresponding with the value of TiVal
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=3, Criteria1:=TiVal
       
    '11.Filter the list for finding the program name values corresponding with the value of PrVal
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=4, Criteria1:=PrVal, Operator:=xlFilterValues
    
              
    ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).SpecialCells(xlCellTypeVisible).Select
    
        DblRws = Selection.Rows.Count
        
        'MsgBox DblRws
    
    '12.Filter *SB subtitle out of the previous filter results
    ws.Range("A2", Range("A2").SpecialCells(xlCellTypeLastCell)).AutoFilter Field:=6, Criteria1:="*SB"
    
    Application.DisplayAlerts = False
    '13.Delete the row with the *SB subtitle
   If DblRws > 1 Then
   ws.Range("A3", Range("A3").SpecialCells(xlCellTypeLastCell)).SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
  
    Cells(1, 1).Select

On Error Resume Next
ws.ShowAllData
On Error GoTo 0
    
    End If
    Next i
     
End Sub