vbanewbie68
Board Regular
- Joined
- Oct 16, 2021
- Messages
- 171
- Office Version
- 365
- Platform
- Windows
- MacOS
Hi
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 screenshot 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
Private tempbook As Workbook, tempsht As Worksheet, rsheet As Worksheet
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 With
End 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
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 screenshot 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
Private tempbook As Workbook, tempsht As Worksheet, rsheet As Worksheet
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 With
End 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