This code works fine to file a year's profit & loss spreadsheet. Tried to get it to work correctly to use the same queries, but only to fill months Jun thru Dec for 2018, in columns B-G. Then, for 2019, I'll use the same code in 2019's db to add months Jan thru Jun in columns H-M to complete a 'report' for an insurance audit. Here is my code that needs modified. I think I attached a model xlsx file You will need to change the name to 'PnL-LI.xlsx".
Code:
Private Sub PopLI_PL_Click()
Dim xlApp As Excel.Application 'declares the variables
Dim lngLastDataRow As Long
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim acRng As Variant
Dim xlRow As Integer
Dim xlCol As Integer
Dim qry As QueryDef
Dim rst As Recordset
Dim xlQry As Integer
Dim GetDBPath As String
Dim strFolder_Path As String
Dim strFolder_PathNew As String
Dim strFile_NameNew As String
Dim PrevYear As Integer
Dim C As Integer
PrevYear = DLookup("[Biz_Year]", "tblProfitLoss")
'Gets the folder name for this busines year's database
GetDBPath = CurrentProject.Path
strFolder_Path = GetDBPath 'Like: "C:\12_R11_TY-18"
strFile_NameNew = strFolder_Path & "" & "PnL-" & "LI" & ".xlsx"
If Dir(strFile_NameNew) = "" Then
MsgBox "You need to create the 'PnL-LI.xlsx' file."
Exit Sub
Else
Set xlApp = New Excel.Application 'creates the variable references
Set xlWB = xlApp.Workbooks.Open(strFile_NameNew)
Set xlWS = xlWB.Worksheets("Sheet1")
Me.CreateLIWCI_label.BackColor = vbYellow 'at start of sheet filling
xlQry = 1 'initializes case counter (ie., query index)
Do
Select Case xlQry
Case Is = 1
Set qry = CurrentDb.QueryDefs("PnLQryRevenue_RV")
xlRow = 8 'starts in row 8: Revenue
Case Is = 2
Set qry = CurrentDb.QueryDefs("PnLQryMaterial_MT")
xlRow = 11 'starts in row 11: Material
Case Is = 3
Set qry = CurrentDb.QueryDefs("PnLQryDump_DP")
xlRow = 12 'starts in row 12: Dump Fee
Case Is = 4
Set qry = CurrentDb.QueryDefs("PnLQryLabor_LB")
xlRow = 13 'starts in row 13: Labor
Case Is = 5
Set qry = CurrentDb.QueryDefs("PnLQryCust_TR")
xlRow = 14 'starts in row 14: Travel: Job
Case Is = 6
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_AD")
xlRow = 18 'starts in row 18: Advertising
Case Is = 7
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_VE")
xlRow = 19 'starts in row 19: Vehicle Expenses
Case Is = 8
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_DE")
xlRow = 22 'starts in row 22: Depreciation
Case Is = 9
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_IN")
xlRow = 25 'starts in row 25: Insurance (Non-Biz)
Case Is = 10
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_IH")
xlRow = 26 'starts in row 26: Insurance (Health)
Case Is = 11
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_LI")
xlRow = 27 'starts in row 27: Interest
Case Is = 12
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_OE")
xlRow = 30 'starts in row 30: Office Expense
Case Is = 13
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_SU")
xlRow = 34 'starts in row 34: Supplies
Case Is = 14
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_TX")
xlRow = 35 'starts in row 35: Taxes & Licenses
Case Is = 15
Set qry = CurrentDb.QueryDefs("PnLQryDeps_TR")
xlRow = 36 'starts in row 36: Travel:Deposits
Case Is = 16
Set qry = CurrentDb.QueryDefs("PnLQryExps_TR")
xlRow = 37 'starts in row 37: Travel:Expenses
Case Is = 17
Set qry = CurrentDb.QueryDefs("PnLQryMatl_TR")
xlRow = 38 'starts in row 38: Travel:Material
Case Is = 18
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_ME")
xlRow = 40 'starts in row 40: Meals & Entertainment
Case Is = 19
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_UT")
xlRow = 41 'starts in row 41: Utilities
Case Is = 20
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_WA")
xlRow = 42 'starts in row 42: Wages
Case Is = 21
Set qry = CurrentDb.QueryDefs("PnLQryExpenses_OT")
xlRow = 43 'starts in row 43: Other
End Select
xlCol = (xlWS.Columns("B").End(xlDown).Row) 'reads data to column 'B'
Set rst = qry.OpenRecordset
'xlCol is the column number of the first empty cell in your spreadsheet that you want to use.
'For B8 as the 'start' cell: Column 'B', xlRow+1=8
C = 2 'make c = 2 to start in column B
xlCol = xlCol + 1 'starts JAN in column B
Do Until rst.EOF
For Each acRng In rst.Fields
xlWS.Cells(xlRow, C).Formula = acRng 'loops across columns range:[B-M] = JAN-JUN
C = C + 1
Next acRng
If xlCol < 7 Then
rst.MoveNext
End If
Loop
Loop Until xlQry = 22 '21 is the query count limit
End If
xlWS.Range("C5").FormulaR1C1 = PrevYear
rst.Close
Set rst = Nothing 'closes & destroys the rst object
Set xlWS = Nothing 'closes & destroys the ws object
xlWB.Close acSaveYes
Set xlWB = Nothing 'closes & destroys the wb object
xlApp.Quit
Set xlApp = Nothing 'closes & destroys the xl object
Me.CreateLIWCI_label.BackColor = vbGreen 'indicates sheet fill completed
End Sub
Attachments
Last edited by a moderator: