Help finish filtering script

I am on my phone so I cant look at the file yet, but why not bring the data into a PROCESS tab then add another bit of code to process it so you can then append it or do whatever it is you want to the data to get it ins a standardized form?

This is not very elegant, but I've just trapped the error, removed the row and let the proc continue.

Sub Split_Stuff()
    Dim sp As Variant
    Dim ws As Worksheet
    Dim LR As Long
    Dim rng As Range, cel As Range
    Dim lngRow As Long
    
    Set ws = Sheets("Sheet1")
    Application.ScreenUpdating = False

    With ws
        .Range(.Cells(1, 3), .Cells(1, 5)).EntireColumn.Delete
        .Columns(1).EntireColumn.Delete
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A1:A" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Range("A1:A" & LR).AutoFilter Field:=1, Criteria1:="=*Grantor*", Operator:=xlAnd
        .Range("A1:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Rows(1).Insert
        .Cells(1, "B").Value = "Section"
        .Cells(1, "C").Value = "Township"
        .Cells(1, "D").Value = "Range"

        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        .Range("A1:D" & LR).AutoFilter Field:=1, Criteria1:="=*Instrument*", Operator:=xlAnd
        .AutoFilter.Range.Offset(1, 0).EntireRow.Delete
        .AutoFilterMode = False
        LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        On Error GoTo DeleteRow
        
        For lngRow = 2 To LR
            sp = Split(Cells(lngRow, 1).Value, "Section")
            .Cells(lngRow, 2).Value = sp(1)
            
            sp = Split(Cells(lngRow, 2).Value, "Township")
            .Cells(lngRow, 3).Value = sp(1)
            
            sp = Split(Cells(lngRow, 3).Value, "Range")
            .Cells(lngRow, 4).Value = sp(1)
            
            sp = Split(.Cells(lngRow, 2).Value, ":")
            .Cells(lngRow, 2).Value = sp(1)
            sp = Split(Replace(.Cells(lngRow, 2).Value, "Township", " "), " ")
            .Cells(lngRow, 2).Value = sp(1)
            sp = Split(Replace(.Cells(lngRow, 3).Value, "Range", " "), " ")
            .Cells(lngRow, 3).Value = sp(1)
            sp = Split(Replace(.Cells(lngRow, 4).Value, "Quarter", " "), " ")
            .Cells(lngRow, 4).Value = sp(1)
            
            GoTo DoNextRow
DeleteRow:
            Cells(lngRow, 1).EntireRow.Delete
            lngRow = lngRow - 1
            LR = LR - 1
DoNextRow:
            If lngRow >= LR Then Exit For
            
        Next lngRow

        .Range("D2:D" & LR).Replace What:=",", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        .Columns(1).EntireColumn.Delete
    End With
    Application.ScreenUpdating = True
End Sub

no - just go into the proc and hit F5

not sure about that one ... if you paste the new code over the old the hotkey should still work. maybe just reset it?