There's a lot of code...sorry. You should know that the error occurs whether I run the subroutines or remark them out and just change the status text. Here goes:
Private Sub cmdStartExport_Click()
Dim DB As Database
Dim xlApp As New Excel.Application
Dim RSBudget As Recordset
Dim WB As Workbook
Dim strFolder As String
Dim strFilename As String
Dim strSheetName As String
Dim introw As Long
Dim strPosition As String
Dim strExportTemplate As String
Dim strStart As String
Dim blnActual As Boolean
Dim blnForecast As Boolean
Dim blnForecast2 As Boolean
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim blnAll As Boolean
Dim blnNR As Boolean
Dim blnCur As Boolean
strStart = txtStart
strFolder = Trim(txtFolder)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
strFilename = Trim(txtFileName)
strFilename = strFolder & strFilename
If Chk1 Then
txtCurrProfile = "Report 1 Complete!"
DoEvents
End If
'blnAll = All(strFolder, strStart, strFilename, WB, xlApp)
If Chk2 Then
txtCurrProfile = "Report 2 Complete!"
DoEvents
End If
'blnNR = NR(strFolder, strStart, strFilename, WB, xlApp)
If Chk3 Then
txtCurrProfile = "Report 3 Complete!"
DoEvents
End If
'blnCur = Cur(strFolder, strStart, strFilename, WB, xlApp)
'txtCurrProfile = "All Reports Complete!"
'DoEvents
End Sub
Private Function All(strFolder As String, strStart As String, strFilename As String, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim RSBudget As Recordset
Dim strSheetName As String
Dim introw As Long
Dim strPosition As String
Dim strExportTemplate As String
Dim blnActual As Boolean
Dim blnForecast As Boolean
Dim blnForecast2 As Boolean
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
All = False
strExportTemplate = strFolder & "Export Template.xlsx"
With xlApp
.Visible = False
Set WB = .Workbooks.Open(strExportTemplate)
.Workbooks(1).SaveAs (strFilename & " All Records.xlsx")
End With
txtCurrProfile = Null
DoEvents
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Budget with fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset
txtCurrProfile = "Exporting " & strFilename & " ..."
DoEvents
xlApp.Worksheets(1).Cells(1, 2) = strStart
RSBudget.MoveFirst
strPosition = RSBudget("Position Number") & ""
introw = 4
Do Until RSBudget.EOF
With xlApp
.Cells(introw, 1) = RSBudget("Position Number")
.Cells(introw, 2) = RSBudget("Budgeted CC")
.Cells(introw, 4) = RSBudget("Job Type")
.Cells(introw, 5) = RSBudget("RLT Member")
.Cells(introw, 6) = RSBudget("Business Need")
.Cells(introw, 11) = Nz(RSBudget("B1"), 0)
.Cells(introw, 16) = Nz(RSBudget("B2"), 0)
.Cells(introw, 21) = Nz(RSBudget("B3"), 0)
.Cells(introw, 26).Formula = "=(+" & .Cells(introw, 11) & "+" & .Cells(introw, 16) & "+" & .Cells(introw, 21) & ")"
.Cells(introw, 29) = Nz(RSBudget("B4"), 0)
.Cells(introw, 34) = Nz(RSBudget("B5"), 0)
.Cells(introw, 39) = Nz(RSBudget("B6"), 0)
.Cells(introw, 44).Formula = "=(+" & .Cells(introw, 29) & "+" & .Cells(introw, 34) & "+" & .Cells(introw, 39) & ")"
.Cells(introw, 47) = Nz(RSBudget("B7"), 0)
.Cells(introw, 52) = Nz(RSBudget("B8"), 0)
.Cells(introw, 57) = Nz(RSBudget("B9"), 0)
.Cells(introw, 62).Formula = "=(+" & .Cells(introw, 47) & "+" & .Cells(introw, 52) & "+" & .Cells(introw, 57) & ")"
.Cells(introw, 65) = Nz(RSBudget("B10"), 0)
.Cells(introw, 70) = Nz(RSBudget("B11"), 0)
.Cells(introw, 75) = Nz(RSBudget("B12"), 0)
.Cells(introw, 80).Formula = "=(+" & .Cells(introw, 65) & "+" & .Cells(introw, 70) & "+" & .Cells(introw, 75) & ")"
.Cells(introw, 83) = Nz(RSBudget("B1"), 0) + Nz(RSBudget("B2"), 0) + Nz(RSBudget("B3"), 0) + Nz(RSBudget("B4"), 0) + Nz(RSBudget("B5"), 0) + Nz(RSBudget("B6"), 0) + Nz(RSBudget("B7"), 0) + Nz(RSBudget("B8"), 0) + Nz(RSBudget("B9"), 0) + Nz(RSBudget("B10"), 0) + Nz(RSBudget("B11"), 0) + Nz(RSBudget("B12"), 0)
End With
blnActual = Actual(strPosition, introw, WB, xlApp)
blnForecast = Forecast(strPosition, introw, WB, xlApp)
blnForecast2 = F2(strPosition, introw, WB, xlApp)
introw = introw + 1
RSBudget.MoveNext
If RSBudget.EOF Then Exit Do
strPosition = RSBudget("Position Number") & ""
txtCurrProfile = "Exporting Position " & strPosition & " ..."
DoEvents
Loop
introw = introw + 2
With xlApp
.Cells(introw, 1) = "Totals:"
.Cells(introw, 11).Formula = "=SUM(K4:" & .Cells((introw - 2), 11).Address(False, False) & ")"
.Cells(introw, 11).Select
.Selection.Copy
.Range("L" & introw & ":CG" & introw).Select
.ActiveSheet.Paste
.Range("K4:CG" & introw).Select
.Selection.NumberFormat = "$#,##0;[Red]$#,##0"
.Application.Goto Reference:="R4C2"
.ActiveWindow.FreezePanes = True
.Workbooks(1).Save
.Workbooks(1).Close
End With
xlApp.Quit
RSBudget.Close
DB.Close
Set xlApp = Nothing
Set RSSpecialist = Nothing
Set DB = Nothing
txtCurrProfile = "All Records Report Complete!"
DoEvents
All = True
End Function
Private Function NR(strFolder As String, strStart As String, strFilename As String, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim RSBudget As Recordset
Dim strSheetName As String
Dim introw As Long
Dim strPosition As String
Dim strExportTemplate As String
Dim blnActual As Boolean
Dim blnForecast As Boolean
Dim blnForecast2 As Boolean
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
NR = False
strExportTemplate = strFolder & "Export Template.xlsx"
With xlApp
.Visible = False
Set WB = .Workbooks.Open(strExportTemplate)
.Workbooks(1).SaveAs (strFilename & " New and Replacements.xlsx")
End With
txtCurrProfile = Null
DoEvents
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Budget with fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset
txtCurrProfile = "Exporting " & strFilename & " ..."
DoEvents
xlApp.Worksheets(1).Cells(1, 2) = strStart
RSBudget.MoveFirst
strPosition = RSBudget("Position Number") & ""
introw = 4
Do Until RSBudget.EOF
If RSBudget("Job Type") = "New" Or RSBudget("Job Type") = "Replacement" Then
With xlApp
.Cells(introw, 1) = RSBudget("Position Number")
.Cells(introw, 2) = RSBudget("Budgeted CC")
.Cells(introw, 4) = RSBudget("Job Type")
.Cells(introw, 5) = RSBudget("RLT Member")
.Cells(introw, 6) = RSBudget("Business Need")
.Cells(introw, 11) = Nz(RSBudget("B1"), 0)
.Cells(introw, 16) = Nz(RSBudget("B2"), 0)
.Cells(introw, 21) = Nz(RSBudget("B3"), 0)
.Cells(introw, 26).Formula = "=(+" & .Cells(introw, 11) & "+" & .Cells(introw, 16) & "+" & .Cells(introw, 21) & ")"
.Cells(introw, 29) = Nz(RSBudget("B4"), 0)
.Cells(introw, 34) = Nz(RSBudget("B5"), 0)
.Cells(introw, 39) = Nz(RSBudget("B6"), 0)
.Cells(introw, 44).Formula = "=(+" & .Cells(introw, 29) & "+" & .Cells(introw, 34) & "+" & .Cells(introw, 39) & ")"
.Cells(introw, 47) = Nz(RSBudget("B7"), 0)
.Cells(introw, 52) = Nz(RSBudget("B8"), 0)
.Cells(introw, 57) = Nz(RSBudget("B9"), 0)
.Cells(introw, 62).Formula = "=(+" & .Cells(introw, 47) & "+" & .Cells(introw, 52) & "+" & .Cells(introw, 57) & ")"
.Cells(introw, 65) = Nz(RSBudget("B10"), 0)
.Cells(introw, 70) = Nz(RSBudget("B11"), 0)
.Cells(introw, 75) = Nz(RSBudget("B12"), 0)
.Cells(introw, 80).Formula = "=(+" & .Cells(introw, 65) & "+" & .Cells(introw, 70) & "+" & .Cells(introw, 75) & ")"
.Cells(introw, 83) = Nz(RSBudget("B1"), 0) + Nz(RSBudget("B2"), 0) + Nz(RSBudget("B3"), 0) + Nz(RSBudget("B4"), 0) + Nz(RSBudget("B5"), 0) + Nz(RSBudget("B6"), 0) + Nz(RSBudget("B7"), 0) + Nz(RSBudget("B8"), 0) + Nz(RSBudget("B9"), 0) + Nz(RSBudget("B10"), 0) + Nz(RSBudget("B11"), 0) + Nz(RSBudget("B12"), 0)
End With
blnActual = Actual(strPosition, introw, WB, xlApp)
blnForecast = Forecast(strPosition, introw, WB, xlApp)
blnForecast2 = F2(strPosition, introw, WB, xlApp)
introw = introw + 1
End If
RSBudget.MoveNext
If RSBudget.EOF Then Exit Do
strPosition = RSBudget("Position Number") & ""
txtCurrProfile = "Exporting Position " & strPosition & " ..."
DoEvents
Loop
introw = introw + 2
With xlApp
.Cells(introw, 1) = "Totals:"
.Cells(introw, 11).Formula = "=SUM(K4:" & .Cells((introw - 2), 11).Address(False, False) & ")"
.Cells(introw, 11).Select
.Selection.Copy
.Range("L" & introw & ":CG" & introw).Select
.ActiveSheet.Paste
.Range("K4:CG" & introw).Select
.Selection.NumberFormat = "$#,##0;[Red]$#,##0"
.Application.Goto Reference:="R4C2"
.ActiveWindow.FreezePanes = True
.Workbooks(1).Save
.Workbooks(1).Close
End With
xlApp.Quit
RSBudget.Close
DB.Close
Set xlApp = Nothing
Set RSSpecialist = Nothing
Set DB = Nothing
txtCurrProfile = "New and Replacement Report Complete!"
DoEvents
NR = True
End Function
Private Function Cur(strFolder As String, strStart As String, strFilename As String, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim RSBudget As Recordset
Dim strSheetName As String
Dim introw As Long
Dim strPosition As String
Dim strExportTemplate As String
Dim blnActual As Boolean
Dim blnForecast As Boolean
Dim blnForecast2 As Boolean
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Cur = False
strExportTemplate = strFolder & "Export Template.xlsx"
With xlApp
.Visible = False
Set WB = .Workbooks.Open(strExportTemplate)
.Workbooks(1).SaveAs (strFilename & " Current Employees.xlsx")
End With
txtCurrProfile = Null
DoEvents
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Budget with fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset
txtCurrProfile = "Exporting " & strFilename & " ..."
DoEvents
xlApp.Worksheets(1).Cells(1, 2) = strStart
RSBudget.MoveFirst
strPosition = RSBudget("Position Number") & ""
introw = 4
Do Until RSBudget.EOF
If RSBudget("Job Type") = "Current" Then
With xlApp
.Cells(introw, 1) = RSBudget("Position Number")
.Cells(introw, 2) = RSBudget("Budgeted CC")
.Cells(introw, 4) = RSBudget("Job Type")
.Cells(introw, 5) = RSBudget("RLT Member")
.Cells(introw, 6) = RSBudget("Business Need")
.Cells(introw, 11) = Nz(RSBudget("B1"), 0)
.Cells(introw, 16) = Nz(RSBudget("B2"), 0)
.Cells(introw, 21) = Nz(RSBudget("B3"), 0)
.Cells(introw, 26).Formula = "=(+" & .Cells(introw, 11) & "+" & .Cells(introw, 16) & "+" & .Cells(introw, 21) & ")"
.Cells(introw, 29) = Nz(RSBudget("B4"), 0)
.Cells(introw, 34) = Nz(RSBudget("B5"), 0)
.Cells(introw, 39) = Nz(RSBudget("B6"), 0)
.Cells(introw, 44).Formula = "=(+" & .Cells(introw, 29) & "+" & .Cells(introw, 34) & "+" & .Cells(introw, 39) & ")"
.Cells(introw, 47) = Nz(RSBudget("B7"), 0)
.Cells(introw, 52) = Nz(RSBudget("B8"), 0)
.Cells(introw, 57) = Nz(RSBudget("B9"), 0)
.Cells(introw, 62).Formula = "=(+" & .Cells(introw, 47) & "+" & .Cells(introw, 52) & "+" & .Cells(introw, 57) & ")"
.Cells(introw, 65) = Nz(RSBudget("B10"), 0)
.Cells(introw, 70) = Nz(RSBudget("B11"), 0)
.Cells(introw, 75) = Nz(RSBudget("B12"), 0)
.Cells(introw, 80).Formula = "=(+" & .Cells(introw, 65) & "+" & .Cells(introw, 70) & "+" & .Cells(introw, 75) & ")"
.Cells(introw, 83) = Nz(RSBudget("B1"), 0) + Nz(RSBudget("B2"), 0) + Nz(RSBudget("B3"), 0) + Nz(RSBudget("B4"), 0) + Nz(RSBudget("B5"), 0) + Nz(RSBudget("B6"), 0) + Nz(RSBudget("B7"), 0) + Nz(RSBudget("B8"), 0) + Nz(RSBudget("B9"), 0) + Nz(RSBudget("B10"), 0) + Nz(RSBudget("B11"), 0) + Nz(RSBudget("B12"), 0)
End With
blnActual = Actual(strPosition, introw, WB, xlApp)
blnForecast = Forecast(strPosition, introw, WB, xlApp)
blnForecast2 = F2(strPosition, introw, WB, xlApp)
introw = introw + 1
End If
RSBudget.MoveNext
If RSBudget.EOF Then Exit Do
strPosition = RSBudget("Position Number") & ""
txtCurrProfile = "Exporting Position " & strPosition & " ..."
DoEvents
Loop
introw = introw + 2
With xlApp
.Cells(introw, 1) = "Totals:"
.Cells(introw, 11).Formula = "=SUM(K4:" & .Cells((introw - 2), 11).Address(False, False) & ")"
.Cells(introw, 11).Select
.Selection.Copy
.Range("L" & introw & ":CG" & introw).Select
.ActiveSheet.Paste
.Range("K4:CG" & introw).Select
.Selection.NumberFormat = "$#,##0;[Red]$#,##0"
.Application.Goto Reference:="R4C2"
.ActiveWindow.FreezePanes = True
.Workbooks(1).Save
.Workbooks(1).Close
End With
xlApp.Quit
RSBudget.Close
DB.Close
Set xlApp = Nothing
Set RSSpecialist = Nothing
Set DB = Nothing
txtCurrProfile = "Current Employee Report Complete!"
DoEvents
Cur = True
End Function
Private Function Actual(strPosition As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim DB As Database
Dim RSActual As Recordset
Dim strCC As String
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim blnCC As Boolean
Actual = False
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Actual with fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSActual = qdf.OpenRecordset
RSActual.MoveFirst
Do While Not RSActual.EOF
If strPosition = RSActual("Position Number") Then
strCC = RSActual("Act Cost Center") & ""
xlApp.Worksheets(1).Cells(introw, 3) = RSActual("Act Cost Center")
xlApp.Worksheets(1).Cells(introw, 12) = Nz(RSActual("A1"))
xlApp.Worksheets(1).Cells(introw, 17) = Nz(RSActual("A2"))
xlApp.Worksheets(1).Cells(introw, 22) = Nz(RSActual("A3"))
xlApp.Worksheets(1).Cells(introw, 27) = xlApp.Worksheets(1).Cells(introw, 12) + xlApp.Worksheets(1).Cells(introw, 17) + xlApp.Worksheets(1).Cells(introw, 22)
xlApp.Worksheets(1).Cells(introw, 30) = Nz(RSActual("A4"))
xlApp.Worksheets(1).Cells(introw, 35) = Nz(RSActual("A5"))
xlApp.Worksheets(1).Cells(introw, 40) = Nz(RSActual("A6"))
xlApp.Worksheets(1).Cells(introw, 45) = xlApp.Worksheets(1).Cells(introw, 30) + xlApp.Worksheets(1).Cells(introw, 35) + xlApp.Worksheets(1).Cells(introw, 40)
xlApp.Worksheets(1).Cells(introw, 48) = Nz(RSActual("A7"))
xlApp.Worksheets(1).Cells(introw, 53) = Nz(RSActual("A8"))
xlApp.Worksheets(1).Cells(introw, 58) = Nz(RSActual("A9"))
xlApp.Worksheets(1).Cells(introw, 63) = xlApp.Worksheets(1).Cells(introw, 48) + xlApp.Worksheets(1).Cells(introw, 53) + xlApp.Worksheets(1).Cells(introw, 58)
xlApp.Worksheets(1).Cells(introw, 66) = Nz(RSActual("A10"))
xlApp.Worksheets(1).Cells(introw, 71) = Nz(RSActual("A11"))
xlApp.Worksheets(1).Cells(introw, 76) = Nz(RSActual("A12"))
xlApp.Worksheets(1).Cells(introw, 81) = xlApp.Worksheets(1).Cells(introw, 66) + xlApp.Worksheets(1).Cells(introw, 71) + xlApp.Worksheets(1).Cells(introw, 76)
xlApp.Worksheets(1).Cells(introw, 84) = xlApp.Worksheets(1).Cells(introw, 27) + xlApp.Worksheets(1).Cells(introw, 45) + xlApp.Worksheets(1).Cells(introw, 63) + xlApp.Worksheets(1).Cells(introw, 81)
If Len(strCC) <> 0 Then
blnCC = CC(strCC, introw, WB, xlApp)
End If
End If
RSActual.MoveNext
If RSActual.EOF Then Exit Do
Loop
RSActual.Close
Actual = True
End Function
Private Function Forecast(strPosition As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim DB As Database
Dim RSForecast As Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Forecast = False
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Forecast with fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSForecast = qdf.OpenRecordset
RSForecast.MoveFirst
Do While Not RSForecast.EOF
If strPosition = RSForecast("Position Number") Then
xlApp.Worksheets(1).Cells(introw, 14) = Nz(RSForecast("F1"))
xlApp.Worksheets(1).Cells(introw, 19) = Nz(RSForecast("F2"))
xlApp.Worksheets(1).Cells(introw, 24) = Nz(RSForecast("F3"))
xlApp.Worksheets(1).Cells(introw, 32) = Nz(RSForecast("F4"))
xlApp.Worksheets(1).Cells(introw, 37) = Nz(RSForecast("F5"))
xlApp.Worksheets(1).Cells(introw, 42) = Nz(RSForecast("F6"))
xlApp.Worksheets(1).Cells(introw, 50) = Nz(RSForecast("F7"))
xlApp.Worksheets(1).Cells(introw, 55) = Nz(RSForecast("F8"))
xlApp.Worksheets(1).Cells(introw, 60) = Nz(RSForecast("F9"))
xlApp.Worksheets(1).Cells(introw, 68) = Nz(RSForecast("F10"))
xlApp.Worksheets(1).Cells(introw, 73) = Nz(RSForecast("F11"))
xlApp.Worksheets(1).Cells(introw, 78) = Nz(RSForecast("F12"))
End If
RSForecast.MoveNext
If RSForecast.EOF Then Exit Do
Loop
RSForecast.Close
Forecast = True
End Function
Private Function F2(strPosition As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim DB As Database
Dim RSForecast2 As Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim M1 As Long
Dim M2 As Long
Dim M3 As Long
Dim M4 As Long
Dim M5 As Long
Dim M6 As Long
Dim M7 As Long
Dim M8 As Long
Dim M9 As Long
Dim M10 As Long
Dim M11 As Long
Dim M12 As Long
F2 = False
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Forecast of Actuals with fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSForecast2 = qdf.OpenRecordset
M1 = 0
M2 = 0
M3 = 0
M4 = 0
M5 = 0
M6 = 0
M7 = 0
M8 = 0
M9 = 0
M10 = 0
M11 = 0
M12 = 0
RSForecast2.MoveFirst
Do While Not RSForecast2.EOF
If strPosition = RSForecast2("Position Number") Then
M1 = M1 + Nz(RSForecast2("F1"))
M2 = M2 + Nz(RSForecast2("F2"))
M3 = M3 + Nz(RSForecast2("F3"))
M4 = M4 + Nz(RSForecast2("F4"))
M5 = M5 + Nz(RSForecast2("F5"))
M6 = M6 + Nz(RSForecast2("F6"))
M7 = M7 + Nz(RSForecast2("F7"))
M8 = M8 + Nz(RSForecast2("F8"))
M9 = M9 + Nz(RSForecast2("F9"))
M10 = M10 + Nz(RSForecast2("F10"))
M11 = M11 + Nz(RSForecast2("F11"))
M12 = M12 + Nz(RSForecast2("F12"))
End If
RSForecast2.MoveNext
If RSForecast2.EOF Then Exit Do
Loop
xlApp.Worksheets(1).Cells(introw, 15) = M1
xlApp.Worksheets(1).Cells(introw, 13) = xlApp.Worksheets(1).Cells(introw, 14) + xlApp.Worksheets(1).Cells(introw, 15)
xlApp.Worksheets(1).Cells(introw, 20) = M2
xlApp.Worksheets(1).Cells(introw, 18) = xlApp.Worksheets(1).Cells(introw, 19) + xlApp.Worksheets(1).Cells(introw, 20)
xlApp.Worksheets(1).Cells(introw, 25) = M3
xlApp.Worksheets(1).Cells(introw, 23) = xlApp.Worksheets(1).Cells(introw, 24) + xlApp.Worksheets(1).Cells(introw, 25)
xlApp.Worksheets(1).Cells(introw, 28) = xlApp.Worksheets(1).Cells(introw, 13) + xlApp.Worksheets(1).Cells(introw, 18) + xlApp.Worksheets(1).Cells(introw, 23)
xlApp.Worksheets(1).Cells(introw, 33) = M4
xlApp.Worksheets(1).Cells(introw, 31) = xlApp.Worksheets(1).Cells(introw, 32) + xlApp.Worksheets(1).Cells(introw, 33)
xlApp.Worksheets(1).Cells(introw, 38) = M5
xlApp.Worksheets(1).Cells(introw, 36) = xlApp.Worksheets(1).Cells(introw, 37) + xlApp.Worksheets(1).Cells(introw, 38)
xlApp.Worksheets(1).Cells(introw, 43) = M6
xlApp.Worksheets(1).Cells(introw, 41) = xlApp.Worksheets(1).Cells(introw, 42) + xlApp.Worksheets(1).Cells(introw, 43)
xlApp.Worksheets(1).Cells(introw, 46) = xlApp.Worksheets(1).Cells(introw, 41) + xlApp.Worksheets(1).Cells(introw, 36) + xlApp.Worksheets(1).Cells(introw, 31)
xlApp.Worksheets(1).Cells(introw, 51) = M7
xlApp.Worksheets(1).Cells(introw, 49) = xlApp.Worksheets(1).Cells(introw, 50) + xlApp.Worksheets(1).Cells(introw, 51)
xlApp.Worksheets(1).Cells(introw, 56) = M8
xlApp.Worksheets(1).Cells(introw, 54) = xlApp.Worksheets(1).Cells(introw, 55) + xlApp.Worksheets(1).Cells(introw, 56)
xlApp.Worksheets(1).Cells(introw, 61) = M9
xlApp.Worksheets(1).Cells(introw, 59) = xlApp.Worksheets(1).Cells(introw, 60) + xlApp.Worksheets(1).Cells(introw, 61)
xlApp.Worksheets(1).Cells(introw, 64) = xlApp.Worksheets(1).Cells(introw, 59) + xlApp.Worksheets(1).Cells(introw, 54) + xlApp.Worksheets(1).Cells(introw, 49)
xlApp.Worksheets(1).Cells(introw, 69) = M10
xlApp.Worksheets(1).Cells(introw, 67) = xlApp.Worksheets(1).Cells(introw, 68) + xlApp.Worksheets(1).Cells(introw, 69)
xlApp.Worksheets(1).Cells(introw, 74) = M11
xlApp.Worksheets(1).Cells(introw, 72) = xlApp.Worksheets(1).Cells(introw, 73) + xlApp.Worksheets(1).Cells(introw, 74)
xlApp.Worksheets(1).Cells(introw, 79) = M12
xlApp.Worksheets(1).Cells(introw, 77) = xlApp.Worksheets(1).Cells(introw, 78) + xlApp.Worksheets(1).Cells(introw, 79)
xlApp.Worksheets(1).Cells(introw, 82) = xlApp.Worksheets(1).Cells(introw, 67) + xlApp.Worksheets(1).Cells(introw, 72) + xlApp.Worksheets(1).Cells(introw, 77)
xlApp.Worksheets(1).Cells(introw, 85) = xlApp.Worksheets(1).Cells(introw, 82) + xlApp.Worksheets(1).Cells(introw, 64) + xlApp.Worksheets(1).Cells(introw, 46) + xlApp.Worksheets(1).Cells(introw, 28)
RSForecast2.Close
F2 = True
End Function
Private Function CC(strCC As String, introw As Long, WB As Workbook, xlApp As Excel.Application) As Boolean
Dim DB As Database
Dim RSCCinfo As Recordset
CC = False
Set DB = CurrentDb
Set RSCCinfo = DB.OpenRecordset("Cost Center Information", dbOpenSnapshot)
RSCCinfo.MoveFirst
Do While Not RSCCinfo.EOF
If Trim(RSCCinfo("Sap#")) = strCC Then
xlApp.Worksheets(1).Cells(introw, 7) = RSCCinfo("Region")
xlApp.Worksheets(1).Cells(introw, 8) = RSCCinfo("Country")
xlApp.Worksheets(1).Cells(introw, 9) = RSCCinfo("Division")
End If
RSCCinfo.MoveNext
If RSCCinfo.EOF Then Exit Do
Loop
CC = True
End Function