Share via

Run-Time Error '9' Subscript Out of Range

Anonymous
2011-11-22T12:29:29+00:00

Hi,

First up, I'm just about at the limit of my abilty with VBA on this, so please be gentle and try and use non-technical words as far as possible. My apologies if I use such words incorrectly :-)

I am trying to compare the contents of two arrays, with a view to deleting those elements in one of them ("vOld") that do not appear in the other ("vNew"). Each array has an unknown number of elements and an unknow number of common elements and may not be in the same order (I can't sort the data before loading it). The format of the elements (they are alphanumeric) is always consistent and no element will ever be repeated in a single array.

I am able to initialise vOld and vNew with their data elements and pointers  (lContentOld, lContentNew) to loop through each element of each array in turn.

So, I think that my code does these things (in order):

  1. Initalise the two arrays and pointers
  2. Examine the first elements in each array
  3. If they are not the same, loop through the vNew array, checking each element in turn to see if it the same as the element in vOld
  4. If I reach the end of vNew without finding a match, I know that the element in vOld is not in vNew and can be deleted
  5. If I do find a match, compare the next element in vOld  with all the elements in vNew starting at the beginning again

Here's what I have so far:

Sub Check_If_Present()

Dim vOld, vNew As Variant, lMaxOld, lMaxNew, lContentOld, lContentNew As Long

'initialise new data array and counter

lMaxNew = Sheets("data").Range("a1").CurrentRegion.Rows.Count

vNew = Sheets("data").Range("c1:c" & lMaxNew)

'initialise old data array and counter

lMaxOld = Sheets("previous scores").Range("a1").CurrentRegion.Rows.Count

vOld = Sheets("previous scores").Range("a1:a" & lMaxOld)

    For lContentOld = LBound(vOld) To UBound(vOld)

        For lContentNew = LBound(vNew) To UBound(vNew)

            If vOld(lContentOld).Value <> vNew(lContentNew).Value Then                If vNew(lContentNew).Value = UBound(vNew) Then

                    MsgBox "delete this old line"  'this is where I'll put the code to delete the element in Old that is not in New

                    Else

                        lContentNew = lContentNew + 1

                End If

            End If

        Next lContentNew

    lContentOld = lContentNew + 1

    Next lContentOld

'loop until

End Sub

I am getting the Run-Time error '9': subscript out of range message at the line:

                        If vOld(lContentOld).Value <> vNew(lContentNew).Value Then

If I correctly understand the other postings on this forum and what I've read on the web, then the code is not able to compare the content of the two arrays because it's not actually lookng in the right place (ie. I thought I'd pointed it at the correct elements in the arrays, but actually haven't).

Can anyone offer any help on what I'm doing wrong and some corrected code that works?

This is on Office 2003 under XP if that makes a difference.

TIA

Dave

Microsoft 365 and Office | Excel | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

Answer accepted by question author

  1. Anonymous
    2011-11-22T13:09:30+00:00

    Hi,

    Try this

    Sub Delete_Me()

    'I actually want to delete the entire row on the "previous scores" worksheet

    '(referenced by the vOld array) that is not present anywhere on the "data"

    'worksheet (referenced by the vNew array).

    Dim vNew As Range, vOLD As Range, c As Range

    Dim CopyRange As Range

    lMaxNew = Sheets("data").Range("C1").CurrentRegion.Rows.Count

    Set vNew = Sheets("data").Range("c1:c" & lMaxNew)

    lMaxOld = Sheets("previous scores").Range("a1").CurrentRegion.Rows.Count

    Set vOLD = Sheets("previous scores").Range("a1:a" & lMaxOld)

    For Each c In vOLD

        If IsError(Application.Match(c.Value, vNew, 0)) Then

         If CopyRange Is Nothing Then

                    Set CopyRange = c.EntireRow

            Else

                    Set CopyRange = Union(CopyRange, c.EntireRow)

            End If

        End If

    Next

    If Not CopyRange Is Nothing Then

    CopyRange.Delete

    End If

    End Sub

    0 comments

4 additional answers

Sort by: Most helpful
Most helpful Newest Oldest
  1. Anonymous
    2011-11-22T14:40:06+00:00

    Mike,

     

    My sincere thanks - works perfectly. Now all I've got to do is understand it :-)

    You're welcome and thanks for the feedback. Here's the code agin with comments which may help in understanding

    Sub Delete_Me()

    'Dim variables and this time

    'I remembered to do lMaxNew & lMaxold

    Dim vNew As Range, vOLD As Range, c As Range

    Dim CopyRange As Range

    Dim lMaxNew As Long, lMaxOld As Long

    'find last row with data ib col c

    lMaxNew = Sheets("data").Range("C1").CurrentRegion.Rows.Count

    'Create a range using the last row

    Set vNew = Sheets("data").Range("c1:c" & lMaxNew)

    'Repeat the above for 'Previous scores' worksheet

    lMaxOld = Sheets("previous scores").Range("a1").CurrentRegion.Rows.Count

    Set vOLD = Sheets("previous scores").Range("a1:a" & lMaxOld)

    'Set up a loop to test each cell in vOLD

    For Each c In vOLD

        'If this line produces an error then it can't find a

        'match for the cell be tested in vOLD in the range

        'set up on sheets 'DATA'

        If IsError(Application.Match(c.Value, vNew, 0)) Then

        'if a match isn't found the this executes. Copyrange

        'is a range and the first line tests if the range contains any

        'range objects. It won't contain any for the first time this executes

         If CopyRange Is Nothing Then

                    'So if there are no range objects in Copyrange

                    ' we add the entire row to the copyrange

                    Set CopyRange = c.EntireRow

            Else

                    'For a second and subsequent pass then we add the

                    'row to the rows already in Copyrange using the UNION method

                    'Note that UNION is OK but can become very slow when dealing with

                    'large ranges

                    Set CopyRange = Union(CopyRange, c.EntireRow)

            End If

        End If

    ' Go back to the start and test the next cell

    Next

    'Once we've finished testing all cells we must test

    'if any rows have been added to Copyrange because

    'if the range is nothing (empty) and we try to delete it

    'we'll get an error

    If Not CopyRange Is Nothing Then

    CopyRange.Delete

    End If

    End Sub

    0 comments
  2. Anonymous
    2011-11-22T14:12:34+00:00

    Mike,

    My sincere thanks - works perfectly. Now all I've got to do is understand it :-)

    0 comments
  3. Anonymous
    2011-11-22T12:51:52+00:00

    Hans,

    Thanks for the response. Apologies for not making myself clear.

    I actually want to delete the entire row on the "previous scores" worksheet (referenced by the vOld array) that is not present anywhere on the "data"  worksheet (referenced by the vNew array).

    Hope this makes some sense!

    0 comments
  4. HansV 462.6K Reputation points MVP Volunteer Moderator
    2011-11-22T12:43:58+00:00

    Do you only want to delete elements from the array vOld, or do you actually want to delete cells from column A on sheet "previous scores" whose value doesn't occur in column C on sheet "data"?

    0 comments