Solved

VBScript to insert new columns and formulas

Posted on 2010-09-02
8
1,235 Views
Last Modified: 2012-05-10
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!
' 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

Open in new window

ZZ-COUNT-SHEET-STAGING-HES10.xls
VBS-TestResults.jpg
0
Comment
Question by:OGSan
  • 5
  • 3
8 Comments
 
LVL 17

Expert Comment

by:calacuccia
ID: 33591885
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.
0
 
LVL 1

Author Comment

by:OGSan
ID: 33592050
Correct, the Count1-2-3 fields are going to be entered manually so there is no formula for those columns.
0
 
LVL 17

Accepted Solution

by:
calacuccia earned 500 total points
ID: 33592215
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.
'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 in new window

0
 
LVL 1

Author Comment

by:OGSan
ID: 33592608
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.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 1

Author Comment

by:OGSan
ID: 33592682
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!
0
 
LVL 1

Author Comment

by:OGSan
ID: 33592707
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

Open in new window

0
 
LVL 17

Expert Comment

by:calacuccia
ID: 33595749
Thanks for the grade
0
 
LVL 1

Author Comment

by:OGSan
ID: 33599697
Thanks for the solution!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Excel VBA - Get files in a folder 5 78
Excel 2016 - Black cell borders 11 27
Excel for Mac - How make those Tabs larger? 2 31
Export Query data to excel file 14 33
A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

912 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now