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.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,826
Messages
5,855,863
Members
431,771
Latest member
CoryMelth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top