Open most recent file and V-lookup to extract data

[goldbeck09]

Hello,

Please be patient with my verbiage, as I am new to VBA coding, I appreciate your help GREATLY! I've done the best research I can do on these threads, but I can't seem find one specific to my quest.

Goal: To write VBA code that opens the most recent file created in a specific folder, open it, and extract data to the current workbook.

Example:

Report 1: "Customer 08-13-2014"
Report 2: "Customer 08-20-2014"

Both Reports are in the same folder. I work in an accounts receivable and these reports are weekly agings that contain invoices, due dates, amount dues, etc... Each week when I create the reports, I add specific notes to the report. So, with each new week (another report), I manually v-lookup(report 2) to the prior weeks report (report 1) and copy them to the new report (report 2)

Data example simplified: In Report 2 Column "x", I v-lookup column "a" in table array report 2; columns "a:f"

Since I am newbie, if I missed any pertinent information, will you please let me know? In my department our reports reference other reports quite often, so we are constantly using vlookup against other reports to retrieve information. And each week those reports are updated with a new file and date, so if I can figure out this VBA coding, it will be a LIFE SAVER! I can't be thankful enough to those who decide to take on this challenge/task with me.

Again, thank you, and please me know what other information would be helpful for this code.

 

[ParamRay]

.
.
.
Is there any pattern to the frequency of your reports? (e.g. In your example, the report's every Wednesday.)

 

[goldbeck09]

Yes, each customer's report is ran weekly on a set specific day.

 

[ParamRay]

.
.

Apologies for the late reply. (It was a public holiday yesterday.)

Please try the following macro. (You don't need to have any of your reports already open in order to run the macro; simply run it from a new workbook.)

However, you will first need to read over the code and make some changes in the places I have indicated using comments.

Sub ExtractData()

    Dim Fold As String
    
    'For previous report:
    Dim Date1 As Date
    Dim File1 As String
    Dim Wb1 As Workbook
    
    'For current report:
    Dim Date2 As Date
    Dim File2 As String
    Dim Wb2 As Workbook
    
    'Set source folder
    'Amend accordingly:
    Fold = "C:\Users\gpeacock\Desktop\Reports"
    
    'Set date of current report
    'Amend accordingly:
    Date2 = DateSerial(2014, 8, 20)
    
    'Get date of previous report
    Date1 = Date2 - 7
    
    'Get filenames of reports
    'Amend prefix/extension accordingly:
    File1 = "Customer " & Format(Month(Date1), "00") & "-" & Format(Day(Date1), "00") & "-" & Year(Date1) & ".xlsx"
    File2 = "Customer " & Format(Month(Date2), "00") & "-" & Format(Day(Date2), "00") & "-" & Year(Date2) & ".xlsx"
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Close reports if already open
    On Error Resume Next
        Workbooks(File1).Close
        Workbooks(File2).Close
    On Error GoTo 0
    
    'Open both reports
    On Error Resume Next
        Set Wb1 = Workbooks.Open(Fold & Application.PathSeparator & File1)
        Set Wb2 = Workbooks.Open(Fold & Application.PathSeparator & File2)
        If Err.Number <> 0 Then
            MsgBox "One or more files do not exist:" & vbCrLf & vbCrLf & _
                Fold & Application.PathSeparator & File1 & vbCrLf & _
                Fold & Application.PathSeparator & File2, vbCritical, "Error"
            Exit Sub
        End If
    On Error GoTo 0
    
    'Place vlookup formulas in current report (col. X):
    With Wb2.Worksheets(1)
        .Range("X2").Formula = "=VLOOKUP($A2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$A:$F,6,FALSE)"
        .Range("X2").AutoFill Destination:=.Range(.Range("X2"), .Range("X" & .Range("W" & .Rows.Count).End(xlUp).Row))
    End With
    
    'Close reports
    Wb1.Close
    'Wb2.Close SaveChanges:=True

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Finished.", vbInformation, "Success"

End Sub

 

[goldbeck09]

Sub ExtractData()

    Dim Fold As String
    
    'For previous report:
    Dim Date1 As Date
    Dim File1 As String
    Dim Wb1 As Workbook
    
    'For current report:
    Dim Date2 As Date
    Dim File2 As String
    Dim Wb2 As Workbook
    
    'Set source folder
    'Amend accordingly:
    Fold = "C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder"
    
    'Set date of current report
    'Amend accordingly:
    Date2 = DateSerial(2014, 8, 26)
    
    'Get date of previous report
    Date1 = Date2 - 7
    
    'Get filenames of reports
    'Amend prefix/extension accordingly:
    File1 = "Occidental Chem Aging " & Format(Month(Date1), "00") & "-" & Format(Day(Date1), "00") & "-" & Year(Date1) & ".xlsx"
    File2 = "Occidental Chem Aging " & Format(Month(Date2), "00") & "-" & Format(Day(Date2), "00") & "-" & Year(Date2) & ".xlsx"
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Close reports if already open
    On Error Resume Next
        Workbooks(File1).Close
        Workbooks(File2).Close
    On Error GoTo 0
    
    'Open both reports
    On Error Resume Next
        Set Wb1 = Workbooks.Open(Fold & Application.PathSeparator & File1)
        Set Wb2 = Workbooks.Open(Fold & Application.PathSeparator & File2)
        If Err.Number <> 0 Then
            MsgBox "One or more files do not exist:" & vbCrLf & vbCrLf & _
                Fold & Application.PathSeparator & File1 & vbCrLf & _
                Fold & Application.PathSeparator & File2, vbCritical, "Error"
            Exit Sub
        End If
    On Error GoTo 0
    
    'Place vlookup formulas in current report (col AF,AG,AG):
    With Wb2.Worksheets(1)
        .Range("AE2").Formula = "=VLOOKUP($AD2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$AI:$AL,2,FALSE)"
        .Range("AE2").AutoFill Destination:=.Range(.Range("AE2"), .Range("AE" & .Range("AD" & .Rows.Count).End(xlUp).Row))
        
        .Range("AF2").Formula = "=VLOOKUP($AD2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$AI:$AL,3,FALSE)"
        .Range("AF2").AutoFill Destination:=.Range(.Range("AF2"), .Range("AF" & .Range("AD" & .Rows.Count).End(xlUp).Row))
    
        .Range("AG2").Formula = "=VLOOKUP($AD2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$AI:$AL,4,FALSE)"
        .Range("AG2").AutoFill Destination:=.Range(.Range("AG2"), .Range("AG" & .Range("AD" & .Rows.Count).End(xlUp).Row))
    End With
    
    'Close reports
    Wb1.Close
    'Wb2.Close SaveChanges:=True

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Finished.", vbInformation, "Success"

End Sub

Here is my final version of the code you supplied. It is quite amazing. I just made adjustments for my directories and added a few additional v-lookups which reference the correct columns I'll be using for a specific aging report.

You've technically completed my request, but if you're willing, and only if you're willing... my inquiring mind, is looking for MORE!

- Is there a way I wouldn't have to enter the most current report date in VBA before running this code?

    'Set date of current report
    'Amend accordingly:
    Date2 = DateSerial(2014, 8, 26)

I researched this code (see below) to pull a file that references the title, and pulls the date format as the most recent file, but I am not advanced enough how to use this code and modify going between two workbooks and the vlookup part. Do you think this is capable with this code?

Sub file_by_datetitle()

Dim nDate As String, fName As String, fPath As String
Dim i As Long
i = 1
 'Where is file located?
fPath = "C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder\"
 
 
nDate = Format(Date - i, "mm-dd-yyyy")
 'Check our path. Dir returns name of file, or "" if not found.
fName = Dir("C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder\Oxy " & nDate & ".xlsx")
 
 
 'Loop while invalid
Do While fName = ""
    i = i + 1
    nDate = Format(Date - i, "mm-dd-yyyy")
     'Check our path
    fName = Dir("C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder\Oxy " & nDate & ".xlsx")
Loop
 
 
 'Now we can open
Workbooks.Open FileName:=fPath & fName


End Sub

THANK YOU! I AM MORE THAN GRATEFUL THAT YOU REPLIED TO MY REQUEST. I have always been torn about forums, and this is my first forum ever, and I can't believe that I've actually received feedback and have advanced my knowledge now in VBA because of people like you. Thank YOU!

 

[ParamRay]

.
.

This should (hopefully) work:

(1) Place both of these sub procedures in the same module.
(2) In your file_by_datetitle procedure, take out the line Dim i as Long and move it to the declarations part of the module (i.e. before any procedures are declared).
(3) At the end of your file_by_datetitle procedure, take out the line that opens the workbook and replace it with Call ExtractData.
(4) In the ExtractData procedure, replace the line Date2 = DateSerial(2014, 8, 26) with Date2 = Date - i.
(5) Run the file_by_datetitle sub procedure.

Explanation:
By declaring i as a module-level variable, it retains its value after the file_by_datetitle procedure has run. This procedure then calls the ExtractData procedure, which uses the final value of i in calculating the Date2 variable.

Hope it helps...

 

[goldbeck09]

- I got the macro to work.This is unbelievable... This macro is the gateway to saving me hours of manual reporting! I am so grateful for your willingness to reach out to my forum. I am going to test this macro on actual reports starting next week.

- This is not a complaint, but the only burst I can see happening is the macro looks for dates 7 days apart. I see an issue when there are holidays and the reports are created on a date period less than or greater than 7 days. For example, if the previous report was ran 08-11-2014, and the next report was generated 08-19-2014, the macro will error because it will look for 08-19-2014 - 7 days = 08-10-2014. I would work around this by temporarily labeling the 08-19-2014, with 08-18-2014, and then just renaming the file after the AWESOME MACRO MADE Would you agree this would be the easiest work around?

Code below includes added formatting and other "cosmetic" edits to the report:

Dim i As Long

Sub file_by_datetitle()

Dim nDate As String, fName As String, fPath As String

i = 1
 'Where is file located?
fPath = "C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder\"
 
 
nDate = Format(Date - i, "mm-dd-yyyy")
 'Check our path. Dir returns name of file, or "" if not found.
fName = Dir("C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder\Occidental Chem Aging " & nDate & ".xlsx")
 
 
 'Loop while invalid
Do While fName = ""
    i = i + 1
    nDate = Format(Date - i, "mm-dd-yyyy")
     'Check our path
    fName = Dir("C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder\Occidental Chem Aging " & nDate & ".xlsx")
Loop

Call OXY_VLOOKUP_FORMAT

    End Sub
    
Sub OXY_VLOOKUP_FORMAT()
    
    Dim Fold As String
    
    'For previous report:
    Dim Date1 As Date
    Dim File1 As String
    Dim Wb1 As Workbook
    
    'For current report:
    Dim Date2 As Date
    Dim File2 As String
    Dim Wb2 As Workbook
    
    'Set source folder
    'Amend accordingly:
    Fold = "C:\Users\Corey\Desktop\EXCEL & VBA\Test Folder"
    
    'Set date of current report
    'Amend accordingly:
    Date2 = Date - i
    
    'Get date of previous report
    Date1 = Date2 - 7
    
    'Get filenames of reports
    'Amend prefix/extension accordingly:
    File1 = "Occidental Chem Aging " & Format(Month(Date1), "00") & "-" & Format(Day(Date1), "00") & "-" & Year(Date1) & ".xlsx"
    File2 = "Occidental Chem Aging " & Format(Month(Date2), "00") & "-" & Format(Day(Date2), "00") & "-" & Year(Date2) & ".xlsx"
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    'Close reports if already open
    On Error Resume Next
        Workbooks(File1).Close
        Workbooks(File2).Close SaveChanges:=True
    On Error GoTo 0
    
    'Open both reports
    On Error Resume Next
        Set Wb1 = Workbooks.Open(Fold & Application.PathSeparator & File1)
        Set Wb2 = Workbooks.Open(Fold & Application.PathSeparator & File2)
        If Err.Number <> 0 Then
            MsgBox "One or more files do not exist:" & vbCrLf & vbCrLf & _
                Fold & Application.PathSeparator & File1 & vbCrLf & _
                Fold & Application.PathSeparator & File2, vbCritical, "Error"
            Exit Sub
        End If
    On Error GoTo 0
    
    'Place vlookup formulas in current report (col AF,AG,AG):
    With Wb2.Worksheets(1)
    Columns("A:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Q:S").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("P:P").Select
    Selection.TextToColumns Destination:=Range("P1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(33, 1), Array(44, 1)), _
        TrailingMinusNumbers:=True
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Shipper City"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "State"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Zip"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "Country"
    Columns("U:W").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("T:T").Select
    Selection.TextToColumns Destination:=Range("T1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(19, 1), Array(33, 1), Array(50, 1)), _
        TrailingMinusNumbers:=True
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "Consignee City"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "ZIP"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "Zip"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "Country"
    Range("W2").Select
    Columns("X:AD").Select
    Selection.EntireColumn.Hidden = True
    Columns("AG:AG").Select
    Selection.EntireColumn.Hidden = True
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "Send?"
    Range("AK1").Select
    ActiveCell.FormulaR1C1 = "Sent"
    Range("AL1").Select
    ActiveCell.FormulaR1C1 = "Notes"
    
        .Range("AJ2").Formula = "=VLOOKUP($AI2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$AI:$AL,2,FALSE)"
        .Range("AJ2").AutoFill Destination:=.Range(.Range("AJ2"), .Range("AJ" & .Range("AI" & .Rows.Count).End(xlUp).Row))
        
        .Range("AK2").Formula = "=VLOOKUP($AI2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$AI:$AL,3,FALSE)"
        .Range("AK2").AutoFill Destination:=.Range(.Range("AK2"), .Range("AK" & .Range("AI" & .Rows.Count).End(xlUp).Row))
    
        .Range("AL2").Formula = "=VLOOKUP($AI2,'[" & Wb1.Name & "]" & Wb1.Worksheets(1).Name & "'!$AI:$AL,4,FALSE)"
        .Range("AL2").AutoFill Destination:=.Range(.Range("AL2"), .Range("AL" & .Range("AI" & .Rows.Count).End(xlUp).Row))
    End With
        
        'Close reports
    Wb1.Close
    'Wb2.Close SaveChanges:=True

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    
    'AUTO FIT VISIBLE COLUMNS
   Dim Col As Range

    Sheets("OCCIDENTAL CHEM").UsedRange.Select
    
    For Each Col In Selection.EntireColumn
        If Col.Hidden = False Then
            Col.EntireColumn.autofit
        End If
         
    Next Col
    
    MsgBox "Finished.", vbInformation, "Success"
End Sub

this is awesssssssssssssssssssssssssssssome! THANK YOU!!!!!

 

[ParamRay]

.
.

Yes, unfortunately Excel doesn't recognise public holidays. So I would use the same workaround as you suggested for the (too few) holidays we have during the year...

 

[goldbeck09]

Ok, this is great though! I showed it off at work today thanks for sharing and teaching your skills.

 

[goldbeck09]

Hi there -- I haven't made any modifcations to the VBA code, but for some reason the code doesn't work on days when I run the report. For example if my most currentreport is 12-15-2014, and the prior report is 12-08-2015, I get the codes error message "cannot find files 12-15-2014 or 12-08-2015". I'm running the macro as of 12-15-2014, so I am wondering if there is something wrong within the excel date system itself or if the macro can be tweaked a little because in order to fix the error message, i re-name the files a day prior to 12-07-2014 amd 12-17-2014, and it works.

Any ideas? Thank you to all for your help.