Trouble With VBA ADO Call

Question

I am relatively new to VBA and need some assistance. I have been piecing together this application from other bits and samples. This was working on Friday but now it isn't and I don't understand what may be causing the issue. I have a master function that calls the subs in order. I have written the UseADO function to take parameters. The first sub that calls UseADO {copyAllRawData()} does work. However, when it calls the sub cashDiscounts(), I get a compile error: Variable not defined error on Sheet4 (the first variable to be passed to UseADO. There is another sub that creates the sheets and I have verified that Sheet4 does exist and if I comment this one out, I get the same error on the sub for Sheet5 processing. Any help would be greatly appreciated. Thanks!

Public Function UseADO(writeToSheet As Worksheet, writeToStartCell As String, queryString As String)

    'Get the Filename
    Dim filename As String
    filename = ThisWorkbook.Path & Application.PathSeparator & "hdremittance.xlsx"


    'Get the Connection
    Dim conn As New ADODB.Connection
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & filename & ";" & _
        "Extended Properties=""Excel 12.0;HDR=Yes;"";"
        
    'Create the SQL Query
    Dim query As String
    query = queryString
    'Query = "Select * from ....
    'query = "Select * From [hdremittance$]"
        
    'Get the data from the workbook
    Dim rs As New Recordset
    rs.Open query, conn
            
    'Write Data
    'Dim sht As String
    'sht = writeToSheet
   
    writeToSheet.Cells.ClearContents
    writeToSheet.Range(writeToStartCell).CopyFromRecordset rs
        
    'Close the Connection
    conn.Close

End Function

Sub copyAllRawData()

UseADO Sheet1, "A2", "Select * From [hdremittance$]"

ThisWorkbook.Sheets(1).Range("A1").Value = "Invoice Number"
ThisWorkbook.Sheets(1).Range("B1").Value = "Keyrec Number"
ThisWorkbook.Sheets(1).Range("C1").Value = "Doc Type"
ThisWorkbook.Sheets(1).Range("D1").Value = "Transaction Value"
ThisWorkbook.Sheets(1).Range("E1").Value = "Cash Discount Amount"
ThisWorkbook.Sheets(1).Range("F1").Value = "Clearing Document Number"
ThisWorkbook.Sheets(1).Range("G1").Value = "Payment/Chargeback Date"
ThisWorkbook.Sheets(1).Range("H1").Value = "Comments"
ThisWorkbook.Sheets(1).Range("I1").Value = "Reason Code"
ThisWorkbook.Sheets(1).Range("J1").Value = "SAP Company Code"
ThisWorkbook.Sheets(1).Range("K1").Value = "PO Number"
ThisWorkbook.Sheets(1).Range("L1").Value = "Reference/Check Number"
ThisWorkbook.Sheets(1).Range("M1").Value = "Invoice Date"
ThisWorkbook.Sheets(1).Range("N1").Value = "Posting Date"
ThisWorkbook.Sheets(1).Range("O1").Value = "Payment Number"

End Sub

Sub cashDiscounts()
UseADO Sheet4, "A2", "Select Top 10000 [Invoice Number],[Keyrec Number],[Doc Type],[Transaction Value],[Reason Code] From [hdremittance$] WHERE [Reason Code] Like '*CASH DISCOUNT%'  "
'D-4080 (Cash/Trade Discount)

ThisWorkbook.Sheets(4).Range("A1").Value = "Invoice Number"
ThisWorkbook.Sheets(4).Range("B1").Value = "Keyrec Number"
ThisWorkbook.Sheets(4).Range("C1").Value = "Doc Type"
ThisWorkbook.Sheets(4).Range("D1").Value = "Transaction Value"
ThisWorkbook.Sheets(4).Range("E1").Value = "Reason Code"
ThisWorkbook.Sheets(4).Range("F1").Value = "Distribution Account"

Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

ThisWorkbook.Sheets(4).Range(Cells(2, "F"), Cells(LastRow, "F")).Value = "D-4080"
    
End Sub
Sub buildNameWorksheets()
'Sheets.Add Count:=[10]
Sheets("Sheet1").Name = "rawData"
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "filterCriteria"                 
'Sheet2
'ThisWorkbook.Sheets(2).Range("A1").Value = "Invoice Number"
'ThisWorkbook.Sheets(2).Range("B1").Value = "Keyrec Number"
'ThisWorkbook.Sheets(2).Range("C1").Value = "Doc Type"
'ThisWorkbook.Sheets(2).Range("D1").Value = "Transaction Value"
'ThisWorkbook.Sheets(2).Range("E1").Value = "Reason Code"
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "invoices"                       
'Sheet3
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "cashDiscounts"                  
'Sheet4
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "tradeDiscounts"                 
'Sheet5
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "earlyPmtFees"                   
'Sheet6
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "rtvDamagedFees"                 
'Sheet7
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "rdcComplianceDeductions"        
'Sheet8
Sheets.Add(After:=Sheets(Sheets.Count)).Name = 
"supplierCollabTeamAnalytics"    'Sheet9
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "newStoreDiscount"               
'Sheet10
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "volumeRebate"                   
'Sheet11
End Sub

There's no sheet with codename = `Sheet4` in `ThisWorkbook` Might help to show your code for creating the worksheets. You can't refer to `Sheet4` in `cashDiscounts` unless that sheet already exists. — Tim Williams, Sep 26 '22 at 23:51
FYI I think you would find this more robust and easier to maintain (once it's working) if you populate the column headers based on the recordset field names. Otherwise, you run the risk of the input column positions changing. Eg see https://stackoverflow.com/questions/4190515/pulling-column-names-into-excel-from-sql-query — Tim Williams, Sep 27 '22 at 00:20
Tim, thanks for your response. I dont understand why that sheet wouldn't exist as it is created as can be seen by the screenshot I post. The odd thing is now the code is failing on a different line of the cashDiscounts sub. As for your other comment, I wanted to pull those headers from the record set field names but couldn't figure out how. Either way, the input column positions should not change ever. If they do, the whole thing will break and no longer work for its intended process. The initial document is an export from another system. — notionDesign, Sep 27 '22 at 13:08
OK, so commenting out that last line ThisWorkbook.Sheets(4)...... allows the code to compile and run. I don't understand why VBA flags different parts of this sub every time I run it. Regardless, the problem now seems to be with that last line which also baffles me as it was working before. — notionDesign, Sep 27 '22 at 14:00
That highlighted line needs explicit worksheet qualifier for the `Cells()` - even though they're inside that `Range()` they will still default to the `ActiveSheet` and not `Sheets(4)` Or slightly easier: `ThisWorkbook.Sheets(4).Range("F2:F" & LastRow).Value = "D-4080"` — Tim Williams, Sep 27 '22 at 15:52
Thanks Again Tim. I do appreciate the help. I have replaced my last line with the one you recommended and now I am back to a compile error. The first time I ran this, it did work and make it through the function. However, it only wrote the "D-4080" in F1 and F2. Not sure why but I wiped everything out, reopened the file and called the function again. Now I am back to a compile error Variable not defined on the Sheet4 variable in the UseADO line. This is so weird to me why it functions sometimes but not others. — notionDesign, Sep 27 '22 at 22:07
"There is another sub that creates the sheets" - `Sheet4` is an object in your workbook, and when the code compiles it needs to be there. If you remove or re-create that sheet after your code has compiled then that may well cause problems. If you're dynamically creating sheets when your code runs, you should use the sheet tab names in the rest of the code, not the codenames. — Tim Williams, Sep 27 '22 at 22:14

Tim Williams · Accepted Answer · 2022-09-28T15:23:10.973

Some suggestions below - compiles, but not tested since I don't have your data. Shows how to skip the whole issue with sheet codenames, and how to use the field names from the recordset as headers in the output.

Option Explicit

'Create one of these for each sheet you create/populate
Const WS_RAW As String = "rawData"
Const WS_FILT As String = "filterCriteria"
Const WS_INVOICES As String = "invoices"
Const WS_CASH_DISC As String = "cashDiscounts"
Const WS_EARLY_PMT As String = "earlyPmtFees"
'etc etc one for each sheet you use

Public Function UseADO(writeToSheet As Worksheet, writeToStartCell As String, queryString As String)

    'Get the Filename
    Dim filename As String, conn As New ADODB.Connection, rs As New Recordset, i As Long
    Dim c As Range
    
    filename = ThisWorkbook.Path & Application.PathSeparator & "hdremittance.xlsx"

    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & filename & ";" & _
              "Extended Properties=""Excel 12.0;HDR=Yes;"";"
    
    writeToSheet.Cells.ClearContents
    
    rs.Open queryString, conn
    Set c = writeToSheet.Range(writeToStartCell)
    'Write the field names
    For i = 0 To rs.Fields.Count - 1 'fields is zero-based
        c.Offset(0, i).Value = rs.Fields(i).Name
    Next i
    'write the data
    If Not rs.EOF Then
        c.Offset(1).CopyFromRecordset rs
    End If
        
    rs.Close   'close the recordset
    conn.Close 'Close the Connection
End Function

'example of calling UseADO
Sub cashDiscounts()
    'D-4080 (Cash/Trade Discount)
    'NOTE: this shows how you can create a new column with a fixed value and a specified name in your recordset
    UseADO ThisWorkbook.Sheets(WS_CASH_DISC), "A2", _
            "Select Top 10000 [Invoice Number],[Keyrec Number],[Doc Type],[Transaction Value]," & _
            " [Reason Code], 'D-4080' As ""Distribution Account"" From [hdremittance$] " & _
            " WHERE [Reason Code] Like '*CASH DISCOUNT%'  "
    
End Sub

'create named sheets from array of constants
Sub buildNameWorksheets()
    Dim wb As Workbook, nm
    
    Set wb = ThisWorkbook 'ActiveWorkbook?
    
    wb.Sheets("Sheet1").Name = "rawData"
    
    For Each nm In Array(WS_FILT, WS_INVOICES, WS_CASH_DISC, WS_EARLY_PMT) 'add the others...
        With wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
            .Name = nm
        End With
    Next nm
End Sub

Thank you for the code sample Tim. I have updated the code with your recommendations. When I attempt to run, it does in fact create the sheets. However when it makes the first UseADO Call, it stalls on the line c.Offset(0, i).Value = rs.Fields(i - 1).Name. The error is with the rs.Fields(i-1).Name portion. " — notionDesign, Sep 28 '22 at 15:18
Hey no problem! Thank you again so much! This works now. Much appreciation sir! — notionDesign, Sep 28 '22 at 16:30

Trouble With VBA ADO Call

1 Answers1