Seeking a macro complicated?

mikemcbain

Board Regular
Joined
Nov 14, 2005
Messages
152
Office Version
  1. 365
Platform
  1. Windows
G'day Magicians

I use Excel 365 and I wish to build a Database in a worksheet called FORM in a file called TodayBT.xlsm located on my desktop which contains the following excellent macro that I use daily to access the data from the directory on my computer called C:\Price\2023\.....

My preference would be for a new macro called GetDataBack in which I could set the number of days to retrieve and it would then change the line in the following
macro from "myDate = Format(Date - 0, "ddmmyyyy")" to " myDate = Format(Date - 1, "ddmmyyyy") and after completing that change it to "myDate = Format(Date - 2, "ddmmyyyy") and
so on until it reaches the preset number of days to retrieve data.

Any help or suggestions greatly welcomed!
Happy Easter to all.

Old Mike.

Sub GetDataToday()

Dim myPath As String
Dim myFile As String
Dim myDate As String
Dim wbDest As Workbook
Dim wsDest As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim i As Integer
Dim lastRow As Long

' Set the path to the folder containing the files
myPath = "C:\Price\2023\"

' Get Data date in the format ddmmyyyy
myDate = Format(Date - 0, "ddmmyyyy")

' Set the destination workbook and worksheet
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Sheets("FORM")

' Loop through all files in the folder that match the pattern
myFile = Dir(myPath & "???" & myDate & "F.DBF")
Do While myFile <> ""
' Open the source workbook and worksheet
Set wbSource = Workbooks.Open(myPath & myFile)
Set wsSource = wbSource.Sheets(1)

Application.Wait (Now + TimeValue("0:00:01"))

' Get the last row of the destination worksheet
lastRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row

' Copy the data from the source worksheet to the destination worksheet, starting from the second row of the current region
wsSource.Range("A2").CurrentRegion.Offset(1, 0).Copy wsDest.Range("A" & lastRow + 1)

Application.Wait (Now + TimeValue("0:00:01"))
' Close the source workbook
wbSource.Close SaveChanges:=False

' Get the next file
myFile = Dir()

Loop

' Save the destination workbook and leave it open
wbDest.Save
wsDest.Activate
wsDest.Range("A1").Select

End Sub
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
From ChatGPT in 20 seconds and working perfectly!

To create the new macro called "GetDataBack" in your Excel workbook "TodayBT.xlsm" and retrieve data from the past few days, you can use the following code:

Sub GetDataBack() Dim myPath As String Dim myFile As String Dim myDate As String Dim wbDest As Workbook Dim wsDest As Worksheet Dim wbSource As Workbook Dim wsSource As Worksheet Dim i As Integer Dim lastRow As Long Dim days As Integer


' Set the path to the folder containing the files
myPath = "C:\Price\2023\"

' Set the number of days to retrieve
days = 5 ' Change this value as per your requirement

' Loop through each day
For i = 0 To days - 1
' Get Data date in the format ddmmyyyy
myDate = Format(Date - i, "ddmmyyyy")

' Loop through all files in the folder that match the pattern for the current date
myFile = Dir(myPath & "???" & myDate & "F.DBF")
Do While myFile <> ""
' Open the source workbook and worksheet
Set wbSource = Workbooks.Open(myPath & myFile)
Set wsSource = wbSource.Sheets(1)

Application.Wait (Now + TimeValue("0:00:01"))

' Set the destination workbook and worksheet
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Sheets("FORM")

' Get the last row of the destination worksheet
lastRow = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row

' Copy the data from the source worksheet to the destination worksheet, starting from the second row of the current region
wsSource.Range("A2").CurrentRegion.Offset(1, 0).Copy wsDest.Range("A" & lastRow + 1)

Application.Wait (Now + TimeValue("0:00:01"))
' Close the source workbook
wbSource.Close SaveChanges:=False

' Get the next file
myFile = Dir()
Loop
Next i

' Save the destination workbook and leave it open
wbDest.Save
wsDest.Activate
wsDest.Range("A1").Select

End Sub

In this new macro, you can set the number of days to retrieve data by changing the value of the "days" variable. In this example, it is set to 5, but you can change it as per your requirement.

Also, note that the code for opening and closing the destination workbook and worksheet has been moved inside the loop, so that it updates the destination worksheet for each day.
 
Upvote 0
Solution

Forum statistics

Threads
1,214,904
Messages
6,122,169
Members
449,070
Latest member
webster33

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
Back
Top