VBA Date import files issue

Viewed 29

The macro was given to me by my predecessor.

I have an issue with the ‘date’ when importing data using the macro. It works well when I import a data file into a macro and transform it into a report, this all works well.

The issue is that if I import a 2nd data file today again after the 1st round it won’t work. I get a prompt message from the macro saying "No new rows to import. If this is wrong check the 'LastImportDates' sheet". It will only work the next day. This is the issue I am struggling with as I need to import several files on the same day.

Please see the VBA codes below, It shows the section of the VBA macro. I hope this is the one that caused the issue. I am hoping that you can point me to where I need to change it, allowing me a import multiple data files on the same day.

I hope everything makes sense. I will endeavor my best to assist you further if needed.

Best regards

V

Sub MainCopyData()

Set rsheet = mbook.Sheets("RAW")
rsheet.Activate
rsheet.Rows("2:100000").EntireRow.Delete

Call FindFile
Call CopyData
rsheet.Activate
tempbook.Close SaveChanges:=False

End Sub

Sub FindFile()

Dim fso As Object 'FileSystemObject
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim Mask As String
Set fso = CreateObject("scripting.FileSystemObject") ' late binding
Set fldStart = fso.GetFolder(ActiveWorkbook.Path) ' <-- use your FileDialog code here
For Each fld In fldStart.Files
If InStr(1, fld.Name, "data_Checkout_Starts_ALL_TIME.csv") > 0 Then
Set fl = fld
Exit For
End If
Next
If fld Is Nothing Then
With Application.FileDialog(msoFileDialogFilePicker)
'Makes sure the user can select only one file
.AllowMultiSelect = False
'Show the dialog box
.Show

'Store in fullpath variable
Set fl = fso.GetFile(.SelectedItems.Item(1))
End WithEnd If

Set tempbook = Workbooks.Open(fl.Path, Local:=True)


End Sub

Sub CopyData()

lastimport = mbook.Sheets("ImportDates").Cells(1, 1).End(xlDown).Value

Set tempsht = tempbook.Sheets(1)
FirstR = 0
LastR = 0
dateC = findCol("EventDate", tempsht)
For x = 2 To tempsht.Cells(1, 1).End(xlDown).Row
If FirstR = 0 And tempsht.Cells(x, dateC) > lastimport Then
FirstR = x
End If

If tempsht.Cells(x, dateC).Value < Date Then
LastR = x
End If

Next x

If FirstR > 0 Then
mbook.Sheets("ImportDates").Cells(1, 1).End(xlDown).Offset(1, 2).Value = LastR - FirstR - 1
mbook.Sheets("ImportDates").Cells(1, 1).End(xlDown).Offset(1, 1).Value = Date
mbook.Sheets("ImportDates").Cells(1, 1).End(xlDown).Offset(1, 0).Value = Date - 1
Else
MsgBox ("No new rows to import. If this is wrong check the 'LastImportDates' sheet")
tempbook.Close SaveChanges:=False
End
End If
rsheet.Activate
tempsht.Rows(FirstR & ":" & LastR).Copy rsheet.Cells(2, 1)


End Sub```
0 Answers
Related