Inserting Time and Sumif Formulas with VBA

[AlexB123]

Hi all,

I have a legacy macro that is used to read data from an excel file to a linked file to get info in to an Access database. The source files are protected, and I don't know where to find the passwords, but I need to get more of the information out of the source file and in to my database. Currently, my macro records the "SQL Strings" (generated by formulas in the source files), and I have had to use string expressions to get the "RequestID" and "payroll amount" in to the database.

My solution is to insert excel formulas into new columns of the linked file to recreate the values I need. The request ID is just a timestamp and the row number of the item in the source sheet. For example, the rows of interest begin on Row 6, and the number of items varies daily. So I would have RequestID's of 061920180006 and 061920180007 if I had two items today. The payroll amount looks for items that have the same reference number, and if so, sums all the matching amounts with sumif. My starting points are two of the formulas that are used within a larger formula to construct the "SQL Strings". They are:

TEXT(SUMIF($E$6:$E$1005,E6,$F$6:$F$1005),"0.00")
TEXT(NOW()),"MMDDYYYY")&TEXT(ROW(),"0000")

Here is the VBA I am working on. How can I rewrite the two formulas above to reference the source file, recreate the data and write the information to new columns in the link file?

Private Sub PullTheGoods()
Dim archiveFolder As String: archiveFolder = "C:\Users\Alcidious\Desktop\DBFiles\"
Dim yearFolder, monthFolder As String
Dim wbfmacro, wbflink, wbfErrors, wbfStats As Workbook
Dim wsfmacro, wsflink, wsfErrors, wsfStats As Worksheet
Dim fMacro, flink, fErrors, fCLT As String
Dim tmpQty As Integer
Dim tmpAmt As Double
Application.DisplayAlerts = False
    flink = "C:\Users\Alcidious\Desktop\DBFiles\ImportLink.xlsx"
    fErrors = "C:\Users\Alcidious\Desktop\DBFiles\ErrorsLink.xlsx"
    fStats = "C:\Users\Alcidious\Desktop\DBFiles\ImportStatLink.xlsx"
    
Set wbfmacro = ThisWorkbook
Set wsfmacro = wbfmacro.Worksheets(1)
        fCLT = wsfmacro.Range("b1").Value
'open and clean up import link
Set wbflink = Workbooks.Open(flink)
Set wsflink = wbflink.Worksheets(1)
lastrowLink = wsflink.Rows.Range("c65536").End(xlUp).Row: lastrowLinkEnd = lastrowLink
    wsflink.Rows("2:600000").Delete Shift:=xlUp
'open and clean up error link
Set wbfErrors = Workbooks.Open(fErrors)
Set wsfErrors = wbfErrors.Worksheets(1)
    
    wsfErrors.Rows("2:2").Delete Shift:=xlUp
    wsfErrors.Range("A2").Value = CDate(Format(Now(), "MM/DD/YY"))
'open and clean up stats link
Set wbfStats = Workbooks.Open(fStats)
Set wsfStats = wbfStats.Worksheets(1)
    
    wsfStats.Range("C2:D13").Value = 0
'process daily file
        If fCLT <> "NO!" Then
            On Error GoTo CLTError
            tmpQty = 0
            tmpAmt = 0
            yearFolder = archiveFolder & "CLT\" & Year(Now): If Len(Dir(yearFolder, vbDirectory)) = 0 Then MkDir (yearFolder)
            monthFolder = yearFolder & "\" & MonthName(Month(Now)): If Len(Dir(monthFolder, vbDirectory)) = 0 Then MkDir (monthFolder)
        ' first step is to save working copy of folder
            Dim wbCLT As Workbook
            Dim wsCLT As Worksheet
            'Dim lastrowCLT As Range
            Set wbCLT = Workbooks.Open(fCLT)
            wbCLT.SaveAs monthFolder & "\CLT " & Format(Now, "YYYY-MM-DD HH.NN.SS") & ".xlsx"
            Set wsCLT = wbCLT.Sheets("Detail")
            
            lastrowCLT = wsCLT.Rows.Range("b1000").End(xlUp).Row
            lastrowLink = wsflink.Rows.Range("a65000").End(xlUp).Row
                            
                wsCLT.Range("A6:A" & lastrowCLT).Copy 'funding src
                wsflink.Range("A" & lastrowLink + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                               
                wsCLT.Range("D6:D" & lastrowCLT).Copy 'PlanCode
                wsflink.Range("B" & lastrowLink + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                wsCLT.Range("G6:G" & lastrowCLT).Copy 'part uid
                wsflink.Range("C" & lastrowLink + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                wsCLT.Range("F6:F" & lastrowCLT).Copy 'amt
                wsflink.Range("D" & lastrowLink + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                wsCLT.Range("E6:E" & lastrowCLT).Copy 'ref#
                wsflink.Range("E" & lastrowLink + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                
                wsCLT.Range("J6:J" & lastrowCLT).Copy 'sql
                wsflink.Range("G" & lastrowLink + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                lastrowLinkEnd = wsflink.Rows.Range("a65000").End(xlUp).Row
                
                wsflink.Range("F" & lastrowLink + 1 & ":F" & lastrowLinkEnd).Value = "CLT"
               
                For j = 6 To lastrowCLT
                
                wsflink.Range("H" & lastrowLink + 1 & ":H" & lastrowLinkEnd).Formula = "=TEXT(NOW(),""MMDDYYYY"")&TEXT(wsCLT.Range(R" & j & "),""0000"")"
    
                 wsflink.Range("I" & lastrowLink + 1 & ":I" & lastrowLinkEnd).FormulaR1C1 = "=TEXT(SUMIF(wsCLT.Range(C5),wsCLT.Range(RC5),wsCLT.Range(C4),""0.00"")"
                
                Next j
    
            tmpQty = wsCLT.Range("E4").Value
            tmpAmt = Abs(wsCLT.Range("F4").Value)
            wbCLT.Close False
            wsfStats.Range("C2").Value = tmpQty
            wsfStats.Range("D2").Value = tmpAmt
        
            Set wbCLT = Nothing
            Set wsCLT = Nothing
        
        End If
Finish:
'save and close link files
wsflink.Columns("C:C").NumberFormat = "@"
Set wsflink = Nothing
Set wsfErrors = Nothing
Set wsfStats = Nothing
wbflink.Close True
wbfErrors.Close True
wbfStats.Close True
Set wbflink = Nothing
Set wbfErrors = Nothing
Set wbfStats = Nothing
Application.DisplayAlerts = True
Application.Quit
Exit Sub

'error handling below
CLTError:
    wsfErrors.Range("B2").Value = "ERROR"
    wsfErrors.Range("M2").Value = "ERROR"
    GoTo Finish
End Sub