Filter CSV Import File

[vcs1161]

I have the following macro that works good to import data into a large spreadsheet I have on a weekly basis. There is a part where I look for data AFTER the import to delete out the records where the value of column 22 <> the worksheet name. Ideally I would like to filter those PRIOR to importing the records in hopes that makes it run a little faster. The piece of code is in the red font color.

The one exception where I want to import ALL the records is when the worksheet begins with "MOD".

Sub MCR_Import_File()
Dim lrow As Long
Dim i As Long
Dim lastcell As String
Dim LastCol As String
Dim SheetName As String
SheetName = Left(ActiveSheet.Name, 2) & "*"
'idenifies the last used column letter
LastCol = Replace(Cells(1, Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column).Address(False, False), "1", "")
With ActiveSheet
        Columns("A:C").Select
    Selection.NumberFormat = "[$-409]m/d/yyyy h:mm AM/PM"
    
    '"[$-409]m/d/yy h:mm AM/PM;@"
    'Formats ZipCode to Number Format that must have five digits
    Columns("N:N").Select
    Selection.NumberFormat = "00000"
      'Formats RimsCode to Text format
     Columns("X:X").Select
     Selection.NumberFormat = "@"
   'Formats Download Date to Date Format
   Columns("AT:AT").Select
    Selection.NumberFormat = "m/d/yyyy"
    'Formats LOS column to number format
    Columns("Q:Q").Select
    Selection.NumberFormat = "0"
          
End With
    With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;R:\RIMS_Std_Data\MCR\X_CSV_Import_Files\RIMS_Stnd_ImportFile_MCR.csv", Destination:=Range( _
      "A" & Cells(Rows.Count, "B").End(xlUp).Row + 1))
        .Name = "ModStndRepImportFile_74"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        
        '1 = xlGeneralFormat General
    '2 = xlTextFormat    Text
    '3 = xlMDYFormat     MDY date
   ' 4 = xlDMYFormat     DMY date
    '9 = xlSkipColumn    Skip column
        .TextFileColumnDataTypes = Array(3, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Selection.Font.Bold = False
    
If Not Left(ActiveSheet.Name, 3) = "Mod" Then 'Only delete records if it is not a certain modality worksheet
     
[COLOR=#ff0000]Application.ScreenUpdating = False
    With ActiveSheet
        .AutoFilterMode = False
        'Filters out modality based on first two character values in column V (ModCategory)
        .Range("A:" & LastCol).AutoFilter Field:=22, Criteria1:="<>" & SheetName
        .AutoFilter.Range.Offset(1, 0).EntireRow.Delete
        .AutoFilterMode = False
    End With[/COLOR]
End If
    
    'Delete duplicates in the event macro refreshed and inserted from the same file twice
    
    'identifies the last used cell address (example: BP825)
    lastcell = Cells.Find(what:="*", After:=[A1], SearchDirection:=xlPrevious).Address
'Sort by Accession Number then descending order by Download Date
ActiveSheet.Sort.SortFields.Clear
    'AccessionNum
   ActiveSheet.Sort.SortFields.Add Key:=Range _
        ("S2:" & "S" & Cells(Rows.Count, "B").End(xlUp).Row + 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    'Then in Descending Order by Download Date
   ActiveSheet.Sort.SortFields.Add Key:=Range _
        ("AT2:" & "AT" & Cells(Rows.Count, "B").End(xlUp).Row + 1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:" & lastcell)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
                End With
        
'this piece will find duplicate Accession Numbers and keep the latest download date
With ActiveSheet
    lrow = .Range("B" & Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Range("S" & i).Value = .Range("S" & i - 1).Value And .Range("AT" & i).Value <= .Range("AT" & i - 1).Value Then
          .Rows(i & ":" & i).Delete
                lrow = lrow - 1
         End If
      Next i
End With
ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B2:" & "B" & Cells(Rows.Count, "B").End(xlUp).Row + 1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:" & lastcell)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("A:" & LastCol).Select
    Columns("A:" & LastCol).EntireColumn.AutoFit
    Range("A2").Select
End Sub

Any input or ideas is greatly appreciated.