Sub DeleteCompanyTotalRows()

    Dim i As Long
    Dim LastRow As Long
    Dim YourColumn As Long
    
    Application.ScreenUpdating = False
    
    YourColumn = 3 ' column containing 'Company Total'
    
    Cells(65536, YourColumn).Select
    
    Selection.End(xlUp).Select
    LastRow = ActiveCell.Row
    
    Cells(1, YourColumn).Select
    i = 1
    Do Until i > LastRow
        'UCase() make this not case sensitive
        If InStr(UCase(Cells(i, YourColumn)), "COMPANY TOTAL") <> 0 Then
            Cells(i, YourColumn).EntireRow.Delete
            i = i - 1 'decriment as all rows have move up row
        End If
        i = i + 1
    Loop
    
    Application.ScreenUpdating = True
End Sub