Copying in VBA

jeskit · February 1st, 2011, 10:21 AM

hi

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"

Code:

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")
ActiveWorkbook.Sheets("ExtractReport").Select
Range("B2").Value = Format(Date, "mm-yyyy")

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

  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

 Next

End With

End Sub

Can anyone help?

Thank you

Jeskit

mtranchi · February 2nd, 2011, 11:01 AM

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:

Code:

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
    Loop
End With

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

'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