We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Course Of The Month
4 days, 7 hours left to enrollBecome a Premium Member and unlock a new, free course in leading technologies each month.
Solved
VBScript to insert new columns and formulas
Posted on 2010-09-02
First off: I am not good at scripting...!
I'm trying to create a VBScript module (not code inside Excel) that is inserting some columns, formatting the headers, and then inserts formulas that need to be replicated down the columns through the last row with data in it. At the end, the worksheet is renamed with the date appended to it.
I've attached a sample of the Excel worksheet that is the target of the script, along with the script itself below. I've also posted a picture of the (ahem) "results" which I'm getting.
I'm embarrassed to post it - but...there it is. Needless to say, it does not work - and I am in dire need of Expert assistance. Help!
VBS-TestResults.jpg
I'm trying to create a VBScript module (not code inside Excel) that is inserting some columns, formatting the headers, and then inserts formulas that need to be replicated down the columns through the last row with data in it. At the end, the worksheet is renamed with the date appended to it.
I've attached a sample of the Excel worksheet that is the target of the script, along with the script itself below. I've also posted a picture of the (ahem) "results" which I'm getting.
I'm embarrassed to post it - but...there it is. Needless to say, it does not work - and I am in dire need of Expert assistance. Help!
' 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
VBS-TestResults.jpg
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
-
5
3
8 Comments
I understood that
Variance1 = count Qty - Count 1
and
Valuation1 = Variance1 x Unit cost
But what should Count1, 2 & 3 be?
I don't see any formula for that.
Variance1 = count Qty - Count 1
and
Valuation1 = Variance1 x Unit cost
But what should Count1, 2 & 3 be?
I don't see any formula for that.
Correct, the Count1-2-3 fields are going to be entered manually so there is no formula for those columns.
The code below accomplishes what I could understand.
However, as the Count field are empty, the variance & valuation formula's which are first written are afterwards replaced by their value: 0.
If have the feeling that's not the goal.
However, as the Count field are empty, the variance & valuation formula's which are first written are afterwards replaced by their value: 0.
If have the feeling that's not the goal.
'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
Thanks for the quick reply, Calaccucia. Actually, the Count1-2-3 cells will be entered in manually afterward, but these worksheets need to be set up ahead of time. I'll test out your solution and get back to you tomorrow. Sorry, have to put this on hold for the rest of the day. Thanks again and I'll post back later.
I posted the state of my current code below. It's working pretty good, Calaccucia! All I need to do is format the cells.
I had to remove the reference to msh and the print command - but aside from those nits, this works!
Thank you again for the quick reply - it's what makes Experts' Exchange the best resource out there!
I had to remove the reference to msh and the print command - but aside from those nits, this works!
Thank you again for the quick reply - it's what makes Experts' Exchange the best resource out there!
Forgot to post the current code.
' 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
Featured Post
We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation)
David Miller (dlmille)
Synopsis
In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Suggested Courses
Course of the Month4 days, 7 hours left to enroll
689 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.