Trouble With VBA ADO Call-CodePudding

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

CodePudding user response：

Tim, Below is the screenshot showing that Sheet4 actually exists.

CodePudding user response：

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 - 1).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