' Open the Excel Spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("P:\_Reporting_Periodic\TEST\ZZ_COUNT_SHEET_STAGING_HES10.xls")
'Insert columns required for physical inventory of the items on this worksheet
Dim variance_frmla
Dim valuation_frmla
Dim i
Dim rg
'Disable screenupdating so the code runs faster
objExcel.ScreenUpdating = False
'Insert column headers beginning in Cell Z2 (Z as in Zebra)
objExcel.Cells(2, 26).Value = "Notes"
objExcel.Cells(2, 27).Value = "Count1"
objExcel.Cells(2, 28).Value = "Variance1 [Count Qty] - [Count1]"
objExcel.Cells(2, 29).Value = "Valuation1 [Variance1] X [Unit Cost]"
objExcel.Cells(2, 30).Value = "Count2"
objExcel.Cells(2, 31).Value = "Variance2 [Count Qty] - [Count2]"
objExcel.Cells(2, 32).Value = "Valuation2 [Variance2] X [Unit Cost]"
objExcel.Cells(2, 33).Value = "Count3"
objExcel.Cells(2, 34).Value = "Variance3 [Count Qty] - [Count3]"
objExcel.Cells(2, 35).Value = "Valuation3 [Variance3] X [Unit Cost]"
'Apply formatting across the column headers Z2 to AI2
With objExcel.ActiveSheet
Set rg = .Range("Z2:AI2")
rg.Interior.ColorIndex = 35
rg.Font.ColorIndex = 30
rg.Font.Bold = True
rg.NumberFormat = "general"
End With
'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
With objExcel.ActiveSheet
Set rg = .Range("AA3:AI3")
'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
variance_frmla = "=IF(Z3<>0,$S3-Z3,0)"
valuation_frmla = "=IF(Z3<>0,($S3-Z3)*Y3,0)"
rg.Offset(0, 0).Formula = variance_frmla
rg.Offset(0, 1).Formula = valuation_frmla
rg.Offset(0, 2).Formula = variance_frmla
rg.Offset(0, 3).Formula = valuation_frmla
rg.Offset(0, 4).Formula = variance_frmla
rg.Offset(0, 5).Formula = valuation_frmla
End With
'This copies the formula all the way down cols AA3, AD3, and AH3
'and then replaces the formula result with the value only (like doing Paste Special --> Values)
With objExcel.ActiveSheet
Set rg = .Range("AA3")
Set rg = .Range(rg, .Cells(.Rows.Count, rg.Column).End(-4162)) 'xLUp = -4162
With rg.Offset(0, 1).Resize(, 10)
.FillDown
.Formula = .Value
End With
End With
'Must turn screenupdating back on
objExcel.ScreenUpdating = True
' Retrieve the separate Date components.
Dim TodayYYYY, TodayMM, TodayDD
TodayYYYY = Year(Date)
TodayMM = Month(Date)
TodayDD = Day(Date)
' Save the sheet - appending TodaysDate to the end of the file-name.
objWorkbook.SaveAs "P:\_Reporting_Periodic\Annual_InventoryWorksheets\ZZ_COUNT_SHEET_STAGING_HES10_" & TodayYYYY & "-" & TodayMM & "-" & TodayDD & ".xls"
' Close Excel with the Quit method on the Application object.
objWorkbook.Application.Quit
' Release the object variable.
Set objExcel = Nothing
ZZ-COUNT-SHEET-STAGING-HES10.xls'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
With objExcel.ActiveSheet
Set rg = .Range("AA3")
'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
variance_frmla = "=IF(AA3<>0,$S3-AA3,0)"
valuation_frmla = "=IF(AA3<>0,($S3-AA3)*$Y3,0)"
rg.Offset(0, 1).Formula = variance_frmla
rg.Offset(0, 1).Copy
rg.Offset(0, 4).PasteSpecial -4123 ' - 4123 = xlPasteFormulas
rg.Offset(0, 7).PasteSpecial -4123
rg.Offset(0, 2).Formula = valuation_frmla
rg.Offset(0, 2).Copy
rg.Offset(0, 5).PasteSpecial -4123
rg.Offset(0, 8).PasteSpecial -4123
End With
'This copies the formula all the way down cols AA3, AD3, and AH3
'and then replaces the formula result with the value only (like doing Paste Special --> Values)
With mSh
Set rg = .Range("AA3")
Set rg = .Range(rg, .Cells(.Cells(.Rows.Count, 1).End(-4162).Row, rg.Column)) 'xLUp = -4162
Debug.Print rg.Address
With rg.Offset(0, -1).Resize(, 10)
.FillDown
.Formula = .Value
End With
End With
' Open the Excel Spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("P:\_Reporting_Periodic\Annual_InventoryWorksheets\ZZ_COUNT_SHEET_STAGING_HES10.xls")
'Insert columns required for physical inventory of the items on this worksheet
Dim variance_frmla
Dim valuation_frmla
Dim i
Dim rg
'Disable screenupdating so the code runs faster
objExcel.ScreenUpdating = False
'Insert column headers beginning in Cell Z2 (Z as in Zebra)
objExcel.Cells(2, 26).Value = "Notes"
objExcel.Cells(2, 27).Value = "Count1"
objExcel.Cells(2, 28).Value = "Variance1 [Count Qty] - [Count1]"
objExcel.Cells(2, 29).Value = "Valuation1 [Variance1] X [Unit Cost]"
objExcel.Cells(2, 30).Value = "Count2"
objExcel.Cells(2, 31).Value = "Variance2 [Count Qty] - [Count2]"
objExcel.Cells(2, 32).Value = "Valuation2 [Variance2] X [Unit Cost]"
objExcel.Cells(2, 33).Value = "Count3"
objExcel.Cells(2, 34).Value = "Variance3 [Count Qty] - [Count3]"
objExcel.Cells(2, 35).Value = "Valuation3 [Variance3] X [Unit Cost]"
'Apply formatting across the column headers Z2 to AI2
With objExcel.ActiveSheet
Set rg = .Range("Z2:AI2")
rg.Interior.ColorIndex = 35
rg.Font.ColorIndex = 30
rg.Font.Bold = True
rg.NumberFormat = "general"
End With
'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
With objExcel.ActiveSheet
Set rg = .Range("AA3")
'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
variance_frmla = "=IF(AA3<>0,$S3-AA3,0)"
valuation_frmla = "=IF(AA3<>0,($S3-AA3)*$Y3,0)"
rg.Offset(0, 1).Formula = variance_frmla
rg.Offset(0, 1).Copy
rg.Offset(0, 4).PasteSpecial -4123 ' - 4123 = xlPasteFormulas
rg.Offset(0, 7).PasteSpecial -4123
rg.Offset(0, 2).Formula = valuation_frmla
rg.Offset(0, 2).Copy
rg.Offset(0, 5).PasteSpecial -4123
rg.Offset(0, 8).PasteSpecial -4123
End With
'This copies the formula all the way down cols AA3, AD3, and AH3
'and then replaces the formula result with the value only (like doing Paste Special --> Values)
With objExcel.ActiveSheet
Set rg = .Range("AA3")
Set rg = .Range(rg, .Cells(.Cells(.Rows.Count, 1).End(-4162).Row, rg.Column)) 'xLUp = -4162
' Debug.Print rg.Address
With rg.Offset(0, -1).Resize(, 10)
.FillDown
'>>> OMIT .Formula = .Value
End With
End With
'Must turn screenupdating back on
objExcel.ScreenUpdating = True
' Retrieve the separate Date components.
Dim TodayYYYY, TodayMM, TodayDD
TodayYYYY = Year(Date)
TodayMM = Month(Date)
TodayDD = Day(Date)
' Save the sheet - appending TodaysDate to the end of the file-name.
objWorkbook.SaveAs "P:\_Reporting_Periodic\Annual_InventoryWorksheets\ZZ_COUNT_SHEET_STAGING_HES10_" & TodayYYYY & "-" & TodayMM & "-" & TodayDD & ".xls"
' Close Excel with the Quit method on the Application object.
objWorkbook.Application.Quit
' Release the object variable.
Set objExcel = Nothing
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.