Almost daily I get invoices from vendors about services they've performed for our caseworkers. The vendor sends me the CW name (somewhat; it's misspelled, or only the first name, or only the last, etc) and the employee ID (also problematic; supposed to be 11 digits, I get anywhere between 0 and 15). For each invoice there are usually 200 plus lines of expenses, sometimes MANY more.

We have 17K CWs. Our IT dept creates an Active Position Report (APR) ALMOST every day that lists each employee and all the pertinent information about each one. I use the APR from the date of the expense to look up the Dept, Program, and other coding elements so we can charge each expense to the right bucket.

Each APR is stored in the APR folder, then under the Fiscal Year, then under the month of the FY. The name of the APR is pretty static, other than that it has the date in the file name, so each APR is different.

Since there's a lot of setup to be done for each invoice, I created the macro below to help me out with it. It's a big help, but one part is big pain.

I have the path to the APR hardcoded in (see section in red). So, since very seldom do I need the same APR more than a few times, I have to constantly update my macro or alter the formulas after they're desposited.

What I'd like is to be able to browse to the folder and select the APR I need, and have the formulas adjust to use my selected APR.

You'd think with all the Covid-19 time I'd be able to work through it, but I'm staying pretty busy so haven't had the opportunity to tackle it, so hoping some kind soul will help me out on this. Any help is appreciated.

Thanks!

Sub VndrCoding_Setup()
'for adding all the columns and basic formulas
Dim Headers() As Variant
Dim DeptID As Integer
Dim PAC As Integer

SpeedOn
Headers() = Array("DeptID", "PAC", "ProjID", "PCA", "Approp", "MM/YY", "Acct", "Cost w Admin Fee", "BA")
Dim LastRow As Long

    DeptID = ActiveCell.Column
   
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                
        With ActiveCell
            'Apply Headers
            ActiveSheet.Cells(.Row, .Column).Resize(1, UBound(Headers) - LBound(Headers) + 1) = Headers
            ActiveSheet.Cells(.Row, .Column).Resize(1, UBound(Headers) - LBound(Headers) + 1).Font.Bold = True
            
            'Formulas for DeptID and PAC
            .Offset(1, 0).Resize(LastRow - .Row).FormulaR1C1 = _
            "=LEFT(VLOOKUP(TEXT(RC7,""00000000000""),'\\121001fs01\share10011\Budget\Active Position Reports\2020\11_2019\[FY 20 Active Positions - Annualized Costs - 11-15-19 - New Format.xlsx]APR Data'!C5:C46,4,FALSE),8)"
            .Offset(1, 1).Resize(LastRow - .Row).FormulaR1C1 = _
            "=LEFT(VLOOKUP(TEXT(RC7,""00000000000""),'\\121001fs01\share10011\Budget\\Active Position Reports\2020\11_2019\[FY 20 Active Positions - Annualized Costs - 11-15-19 - New Format.xlsx]APR Data'!C5:C46,39,FALSE),8)"
            
            'ProjID, PCA, Approp
            .Offset(1, 2).Resize(LastRow - .Row).FormulaR1C1 = _
            "=VLOOKUP(RC" & DeptID + 1 & ",'\\121001fs01\share10011\Accounting\Z4116\[Coding Workbook.xlsm]FY20 All Dept Coding'!C8:C11,2,FALSE)"
            .Offset(1, 3).Resize(LastRow - .Row).FormulaR1C1 = _
            "=VLOOKUP(RC" & DeptID + 1 & ",'\\121001fs01\share10011\Accounting\Z4116\[Coding Workbook.xlsm]FY20 All Dept Coding'!C8:C11,3,FALSE)"
            .Offset(1, 4).Resize(LastRow - .Row).FormulaR1C1 = _
            "=VLOOKUP(RC" & DeptID + 1 & ",'\\121001fs01\share10011\Accounting\Z4116\[Coding Workbook.xlsm]FY20 All Dept Coding'!C8:C11,4,FALSE)"
            
            'All the Rest
            .Offset(1, 5).Resize(LastRow - .Row).FormulaR1C1 = "=TEXT(RC[-22],""mm/yy"")"
            .Offset(1, 6).Resize(LastRow - .Row).FormulaR1C1 = "729905"
            .Offset(1, 7).Resize(LastRow - .Row).FormulaR1C1 = "=ROUND(RC[-17]*1.1,2)"
            .Offset(-1, 7).FormulaR1C1 = "=SUM(R[2]C:R[" & LastRow & "]C)"
            .Offset(1, 8).Resize(LastRow - .Row).FormulaR1C1 = _
            "=VLOOKUP(RC" & DeptID & ",'\\12fs01\share10011\Accounting\Z4116\[Coding Workbook.xlsm]FY20 All Dept Coding'!C3:C5,3,FALSE)"
        End With
        Range(ActiveCell, ActiveCell.End(xlToRight)).EntireColumn.AutoFit
    End With
    SpeedOff
End Sub