Here is the current code for the import macro:
Sub DRR_IMPORT()
Application.DisplayAlerts = False
Dim strPath As String
Dim strFile As String
Dim lastRow As Long
Dim X As Long
Dim varDRR As Variant
Sheets("RELEASES").Select
lastRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
For X = lastRow To 2 Step -1
If Cells(X, 2).value <= Date - 2 Then
Cells(X, 2).EntireRow.Delete
End If
Next
Range("A1000").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Range("A2").Select
Worksheets("REF3").Select
Cells.Range("A2").Select
While ActiveCell.value <> ""
varDRR = ActiveCell.value
strPath = "R:\PT\Current\"
strFile = Dir(strPath & varDRR & ".csv")
Do While strFile <> ""
With ActiveWorkbook.Worksheets.Add
With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
Destination:=.Range("A1"))
.Parent.Name = Replace(strFile, ".csv", "")
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End With
strFile = Dir
lastRow = Range("D:D").SpecialCells(xlLastCell).Row
Range("D1").Select
X = 1
Do While X < lastRow
If ActiveCell = "" Then
ActiveCell.EntireRow.Delete Shift:=xlUp
ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
X = X + 1
Loop
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
Application.CutCopyMode = False
Columns("A:A").Copy
Columns("C:C").Select
Selection.PasteSpecial
Range("B2:C2").Select
Range(Selection, Selection.End(xlDown)).Copy
Sheets("RELEASES").Select
Range("A1000").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
On Error Resume Next
Selection.PasteSpecial
Sheets(varDRR).Delete
Loop
Worksheets("REF3").Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Bookmarks