Wrox Programmer Forums
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old February 1st, 2011, 10:21 AM
Friend of Wrox
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default Copying in VBA


I have having an issue with code below. The code below should open two workbooks called template and participation. It should then copy the text values from the participation workbook in the column A cells but only when the corresponding cells in Column O and AZ equal "True" and then paste them in the template workbook in sheet 1 cell range B2:CC2

But it does not work. It just produces an error when it gets to the line highlighted in red, saying "Run-time error '9': Subscript out of range"

Sub DealerData_Extract()
Dim rngCell As Range
Dim i       As Long

Application.Workbooks.Open ("C:\Documents and Settings\SeymourJ\Desktop\Tasks\HondaExtractMacro\DealerData_Extract_Feed_Template.xls")
Range("B2").Value = Format(Date, "mm-yyyy")

Application.Workbooks.Open ("C:\Documents and Settings\SeymourJ\Desktop\Tasks\HondaExtractMacro\Actual_Participation_12_2010.csv")

  i = 1

With ActiveWorkbook.Worksheets("Actual_Participation_12_2010.csv")
 For Each rngCell In .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)    

If rngCell.Offset(, 15).Value = "True" And rngCell.Offset(, 52).Value = "True" Then
        Workbooks("DealerData_Extract_Feed_Template.xls").Worksheets("ExtractData").Range("B" & i + 1).Value = rngCell.Value

    End If

    i = Workbooks("DealerData_Extract_Feed_Template.xls").Worksheets("ExtractData").Range("B" & Rows.Count).End(xlUp).Row


End With

End Sub
Can anyone help?

Thank you

Old February 2nd, 2011, 11:01 AM
Friend of Wrox
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts

first off, if you ever have to refer to an object (e.g. a workbook, a range) more than once, it's more efficient to set it equal to a variable and refer to the variable. this will make your code run faster
try this:
Sub DealerData_Extract()
Dim wbkTemplate As Workbook
Dim wbkCsv As Workbook
Dim shtExtractData As Sheet
Dim rgCellA1 As Range
Dim iRowOffset As Long
Dim iNextRow As Long

'Workbooks is a member of globals, no need to preface with Application
Set wbkTemplate = Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\Tasks\HondaExtractMacro\DealerData_Extract_Feed_Template.xls")
Set shtExtractData = wbkTemplate.Sheets("ExtractData")

'figure out the next row that's gonna take data
'You may need to add to iNextRow if you have empty rows at the top of the worksheet. Like so:
'iNextRow = WorksheetFunction.CountA(shtExtractData.Range("B:B")) + 5
iNextRow = WorksheetFunction.CountA(shtExtractData.Range("B:B")) + 2

'You should rarely if ever select a range or sheet etc. Slows down code execution
'The cell value is the default property, so no need to specify it.
Sheets("ExtractReport").Range("B2") = Format(Date, "mm-yyyy")

Set wbkCsv = Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\Tasks\HondaExtractMacro\Actual_Participation_12_2010.csv")
Set rgCellA1 = wbkCsv.Sheets(1).Range("A1")

With rgCellA1
    Do While Not IsEmpty(.Offset(iRowOffset, 0))
        'no quotations around the word true, it's a boolean value
        If .Offset(iRowOffset, 15) = True And .Offset(iRowOffset, 52).Value = True Then
            shtExtractData.Cells(iNextRow, 2) = .Offset(iRowOffset, 0)
            iNextRow = iNextRow + 1
        End If
        iRowOffset = iRowOffset + 1
End With

''uncomment this once you're code is working fine so it automatically saves and closes the workbooks
'wbkTemplate.Close True

'don't forget to release your computer's memory. you should do this with every variable that you must use the "Set" keyword with (objects).
Set wbkTemplate = Nothing
Set wbkCsv = Nothing
Set shtExtractData = Nothing
Set rgCellA1 = Nothing
End Sub

Similar Threads
Thread Thread Starter Forum Replies Last Post
Copying images arnabghosh PHP How-To 1 February 21st, 2006 07:49 AM
Copying from one table to another Clive Astley VB Databases Basics 2 August 23rd, 2005 12:48 AM
Word 2000 VBA AutoCorrect copying rjohnson VB How-To 0 August 30th, 2004 12:40 PM
Copying files marclena General .NET 2 June 18th, 2004 08:24 AM
Copying a File, How? xgbnow Visual C++ 3 September 16th, 2003 03:37 AM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.