Subscript out of Range

[charllie]

Hi Folks,

Can someone please point out to me the error.

When i run the code below i get the runtime error 9 Subscript out of Range message and this line of code is higlighted.

lRow = wsTo.Cells(Rows.count, vData(0)).End(xlUp).Row

I would be grateful if someone could tell me what is wrong with this code in order to get it working again.

MAIN CODE:

Dim bSelected() As Boolean, iPtr As Integer, lCur As Long, lRow As Long
    Dim R As Range
    Dim vFrCols As Variant, vData() As Variant
    Dim wsTo As Worksheet

    If ActiveSheet.Name <> "Schedule 2" Then
        MsgBox "Currently Active Sheet Is Not Warehouse Schedule"
        Sheets("Schedule 2").Select
        Exit Sub
    End If

    Set wsTo = Sheets("Priority List")
    ReDim bSelected(0 To 0)

    For Each R In Selection
        lCur = R.Row
        If UBound(bSelected) < lCur Then ReDim Preserve bSelected(0 To lCur)
        bSelected(lCur) = True
    Next R

    vFrCols = Split(expression:="A,F,B,J,I", delimiter:=",")
    ReDim vData(1 To UBound(vFrCols) + 1)
'    lRow = 4 'This tells it where to place the information copied starting at row 5
    lRow = wsTo.Cells(Rows.count, vData(0)).End(xlUp).Row  'finds the last row in column A (i.e. contents of vData(0) )
            'and then tells it where to place the information copied starting at row 5
    For lCur = 2 To UBound(bSelected)
        If bSelected(lCur) = True Then
            lRow = lRow + 1
            For iPtr = 0 To UBound(vFrCols)
                vData(iPtr + 1) = Cells(lCur, vFrCols(iPtr)).Value
            Next iPtr
            With Rows(lCur).Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
            wsTo.Range("B" & lRow, Cells(lRow, UBound(vData)).Address).Value = vData
        End If
    Next lCur

Thanks

 

[GlennUK]

Go into debug mode and look at all of the pointers being used in that line of code. What do you see?

 

[Andrew Poulsom]

Should it be?

lRow = wsTo.Cells(Rows.count, vFrCols(0)).End(xlUp).Row

The lower bound of vData is 1 and in any case you haven't filled the array yet.

 

[charllie]

Hi Guys,

Thanks for your replies.

Andrew,
I tried your code and it seemed to work ok. However the problem i was trying to solve with the code has not.

If i copy 5 rows across to the other worksheet using this code it all woks fine now after installing your code. However, if i choose another 5 rows and copy them across, instaed of placing them underneath the first 5 rows i copied across (giving me a total of 10 rows), it copies over them replacing them.

Can you or anyone else see by looking at it, what is wrong with the code and why it does this? If you don't mind that is.

Thanks

 

[Andrew Poulsom]

Well the code is copying into column B, while vFrCols(0) is "A" which may be blank.

Why not just find the last row in column B?

lRow = wsTo.Cells(wsTo.Rows.count, 2).End(xlUp).Row

 

[charllie]

Hi Andrew,

Thanks for your help. It was column A i needed so amended a bit and everything works as it should now.

Thanks for the help and code.