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
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