Excel - VBA to copy selected formula values down column

Hi, Experts -
I can't seem to get my formula's values (result of formula) copied down column W.  The formula gets inserted okay into W2, but the last step isn't working for me.  Can someone provide an assist, please?
   
Dim frmla
Dim i 
Dim rg 

'Disable screenupdating so the code runs faster
objExcel.ScreenUpdating = False

'Insert column headers
objExcel.Cells(1, 23).Value = "HEE Particip"


With objExcel.ActiveSheet
	Set rg = .Range("W2") 'Formulas inserted beginning with this cell
	Set rg = .Range(rg, .Cells(.Rows.Count, rg.Column).End(-4162)) 'xLUp = -4162

	'This inserts the VLOOKUP formula into cells W2
   	frmla = "=VLOOKUP(LEFT($I2,10),'X:\FINANCE Tree\[DeptTree(2011)_103111_Dist.xls]dept-tree'!$A$2:$P$1502,10,FALSE)"		
	.Range("W2").Formula = frmla
	

End With

'This copies the formula all the way down column W
'and then replaces the formula result with the value only (like doing Paste Special --> Values)
With rg.Offset(0, 1).Resize(, 1)
    .FillDown
    .Formula = .Value
End With

Open in new window

LVL 1
OGSanAsked:
Who is Participating?
 
NorieVBA ExpertCommented:
I still think the problem is because Excel is displaying a dialog.

I think the dialog might be something to do with this file:

'X:\FINANCE Tree\[DeptTree(2011)_103111_Dist.xls]dept-tree'

That's being used for the lookup range of the VLOOKUP.

Is the path/filename/worksheet name correct?
0
 
NorieVBA ExpertCommented:
Are there any values in column W before you run this code?

If there aren't it's probably not a good idea to use that column to determine how many rows the formula should be filled down.

Try basing that on another column, that will definitely have something in it - Column I might be a good candidate.

You could also just enter the formula in one 'go'.

Perhaps something like this.
Cells(1, 23).Value = "HEE Particip"


With ActiveSheet
      
        Set rg = .Range("W2:W" & .Cells(.Rows.Count, "I").End(-4162).Row)  'xLUp = -4162

        'This inserts the VLOOKUP formula into cells W2
        frmla = "=VLOOKUP(LEFT($I2,10),'X:\FINANCE Tree\[DeptTree(2011)_103111_Dist.xls]dept-tree'!$A$2:$P$1502,10,FALSE)"
        rg.Formula = frmla
        rg.Value = rg.Value

End With

Open in new window

Please note this puts the formula in column W, it doesn't enter it in any other columns.
0
 
OGSanAuthor Commented:
Thanks, imnorie - I inserted your code in place of mine and had to add "objExcel.ActiveSheet" on line 4 above.  When it runs, it just hangs until I use task manager to kill Excel.  Then the script issues an error on line 10 above stating, "Remote procedure call failed."  Any suggestions?
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
NorieVBA ExpertCommented:
Where are you running this code from?

Did you change anything apart from adding the reference for the Excel application?
0
 
OGSanAuthor Commented:
Running it from my PC right now, but once working, it will be executing off a dedicated server we use for report generation.
Did not change anything except for the addition of the objExcel reference.
0
 
NorieVBA ExpertCommented:
So this code is in Excel VBA?
0
 
OGSanAuthor Commented:
Oh, no, sorry - it's VBScript.  My bad.  Below is the entire code.
 
'==========================================================================
' Open the TOAD Excel Spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("J:\Sales Comp & Perf Mgmt\He'e\BI_HEE_Extract\HT_BI_HEE_Extract.xls")


'Lookup Node1-2-3 values from current Dept Tree into columns V,W, X, and Y
Dim frmla
Dim i 
Dim rg 

'Disable screenupdating so the code runs faster
objExcel.ScreenUpdating = False

'Insert column headers
objExcel.Cells(1, 23).Value = "HEE Particip"

With objExcel.ActiveSheet
      
        Set rg = .Range("W2:W" & .Cells(.Rows.Count, "I").End(-4162).Row)  'xLUp = -4162

        'This inserts the VLOOKUP formula into cell W2 and copies it all the way down...
        frmla = "=VLOOKUP(LEFT($I2,10),'X:\FINANCE Tree\[DeptTree(2011)_103111_Dist.xls]dept-tree'!$A$2:$P$1502,10,FALSE)"
        rg.Formula = frmla
        rg.Value = rg.Value

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 "J:\Sales Comp & Perf Mgmt\He'e\BI_HEE_Extract\HT_BI_HEE_Extract_" & TodayYYYY & "-" & TodayMM & "-" & TodayDD & ".xls"


' Close Excel with the Quit method on the Application object.
objWorkbook.Application.Quit

' Release the object variable.
Set objExcel = Nothing

' Delete the original TOAD extract file
'dim filesys, TOAD_Extract
'set filesys = CreateObject ("Scripting.FileSystemObject")
'set TOAD_Extract = filesys.GetFile("J:\Sales Comp & Perf Mgmt\He'e\BI_HEE_Extract\HT_BI_HEE_Extract.xls")
'TOAD_Extract.Delete

Open in new window

0
 
NorieVBA ExpertCommented:
I've not really used VBScript that much with Excel.

Usually just basic things like copying worksheets between workbooks.

I only tested the code in Excel VBA, so I didn't need the objExcel reference.

One thing that springs to mind is the workbook isn't being closed for some reason - perhaps Excel has thrown up a dialog that's not dealt with in the code.

Perhaps if you made the Excel instance visible you might see what's going on.

That's all I can think of right now but I could probably test tomorrow.
0
 
OGSanAuthor Commented:
Thanks, imnorie - that was it!  The error msg was waiting for a confirmation. Turns out the workbook was updated and the specific worksheet tab was misnamed. Doh! (headslap)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.