Filter CSV Import File

vcs1161

New Member
Joined
Sep 29, 2014
Messages
1
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".

Code:
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.
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Watch MrExcel Video

Forum statistics

Threads
1,109,026
Messages
5,526,325
Members
409,696
Latest member
EERS

This Week's Hot Topics

Top