Results 1 to 8 of 8

Thread: 'runtime error 9 subscript out of range' in xls macro

  1. #1

    Thread Starter
    New Member
    Join Date
    Aug 2012
    Posts
    4

    'runtime error 9 subscript out of range' in xls macro

    duplicata macro.docon bold line in code below, debug flags 'next_row_address_columns(address_column) = <subscript out of range>' even though it also flags 'address_column=1'

    how can this be so especially when previous line executes OK?


    Sub duplicata()

    ' this xls macro removes duplicate addresses from a csv export of an outlook contacts file sorted by first & last names

    Dim last_row As Integer
    last_row = 1134

    Dim first_row As Integer
    first_row = 2

    Dim first_name_column As Integer
    first_name_column = 2

    Dim last_name_column As Integer
    last_name_column = 4

    Dim number_of_addresses As Integer
    number_of_addresses = 3
    Dim current_row_addresses(1 To 3) As String
    Dim next_row_addresses(1 To 3) As String

    Dim first_address_column As Integer
    first_address_column = 9

    Dim number_of_address_columns As Integer
    number_of_address_columns = 7
    Dim current_row_address_columns() As String
    ReDim current_row_address_columns(1 To 7) As String
    Dim next_row_address_columns() As String
    ReDim next_row_address_columns(1 To 7) As String

    Dim notes_column As Integer
    notes_column = 78

    Dim notes(1 To 2) As String
    Dim current_row_first_name As String
    Dim current_row_last_name As String
    Dim next_row_first_name As String
    Dim next_row_last_name As String

    Dim address, address_column, address_a, address_b, next_row_address, current_row_address As Integer

    ' for each pair of adjacent contacts (sorted by first & last name)

    For current_row = first_row To last_row - 1

    ' for each pair of adjacent rows with same first & last names (same contact)

    current_row_first_name = Cells(current_row, first_name_column)
    current_row_last_name = Cells(current_row, last_name_column)
    next_row_first_name = Cells(current_row + 1, first_name_column)
    next_row_last_name = Cells(current_row + 1, last_name_column)
    If current_row_first_name = next_row_first_name And current_row_last_name = next_row_last_name Then

    ' concatenate the current & next row address columns

    For address = 1 To number_of_addresses
    For address_column = 1 To number_of_address_columns
    current_row_address_columns(address_column) = Cells(current_row, first_address_column + (address - 1) * number_of_address_columns + address_column - 1).Value
    next_row_address_columns(address_column) = Cells(current_row + 1, first_address_column + (address - 1) * number_of_address_columns + address_column - 1).Value
    Next
    current_row_addresses(address) = Join(current_row_address_columns, "$")
    next_row_addresses(address) = Join(next_row_address_columns, "$")
    Next

    ' remove any duplicate addresses in current row
    For address_a = 1 To number_of_addresses - 1
    For address_b = a + 1 To number_of_addresses
    If current_row_addresses(address_a) = current_row_addresses(address_b) Then
    current_row_addresses(address_b) = ""
    End If
    Next
    Next

    ' remove any duplicate addresses from next row

    For next_row_address = 1 To number_of_addresses
    For current_row_address = 1 To number_of_addresses
    If next_row_addresses(next_row_address) = current_row_addresses(current_row_address) Then
    next_row_addresses(next_row_address) = ""
    Exit For
    End If
    Next

    ' move addresses from next row to empty addresses in current row or transfer to notes

    If next_row_addresses(next_row_address) <> "" Then
    For current_row_address = 1 To number_of_addresses
    If current_row_addresses(current_row_address) = "" Then
    current_row_addresses(current_row_address) = next_row_addresses(next_row_address)
    next_row_addresses(next_row_address) = ""
    Exit For
    End If
    Next
    If next_row_address <> "" Then
    notes(1) = Cells(current_row, notes_column)
    notes(2) = next_row_addresses(next_row_address)
    Cells(current_row, notes_column) = Join(notes, " ")
    End If
    End If
    Next

    ' refresh current & next row addresses

    For address = 1 To number_of_addresses
    current_row_address_columns = Split(current_row_addresses(address), "$")
    next_row_address_columns = Split(next_row_addresses(address), "$")
    For address_column = 1 To number_of_address_columns
    Cells(current_row, first_address_column + (address - 1) * number_of_address_columns + address_column - 1) = current_row_address_columns(address_column)
    Cells(current_row + 1, first_address_column + (address - 1) * number_of_address_columns + address_column - 1) = next_row_address_columns(address_column)
    Next
    Next
    End If
    Next
    End Sub

  2. #2

    Thread Starter
    New Member
    Join Date
    Aug 2012
    Posts
    4

    Re: 'runtime error 9 subscript out of range' in xls macro

    come on guys & gals! one of you must be able to throw some light on this patch of vb darkness..........................

  3. #3
    PowerPoster
    Join Date
    Jul 2006
    Location
    Maldon, Essex. UK
    Posts
    6,334

    Re: 'runtime error 9 subscript out of range' in xls macro

    I think that you're not getting any takers because, as posted, your code is very difficult to read (no indentation). I've adjusted it
    Code:
    Option Explicit
    
    Sub duplicata()
    
    ' this xls macro removes duplicate addresses from a csv export of an outlook contacts file sorted by first & last names
    
    Dim last_row As Integer
    last_row = 1134
    
    Dim first_row As Integer
    first_row = 2
    
    Dim first_name_column As Integer
    first_name_column = 2
    
    Dim last_name_column As Integer
    last_name_column = 4
    
    Dim number_of_addresses As Integer
    number_of_addresses = 3
    Dim current_row_addresses(1 To 3) As String
    Dim next_row_addresses(1 To 3) As String
    
    Dim first_address_column As Integer
    first_address_column = 9
    
    Dim number_of_address_columns As Integer
    number_of_address_columns = 7
    Dim current_row_address_columns() As String
    ReDim current_row_address_columns(1 To 7) As String
    Dim next_row_address_columns() As String
    ReDim next_row_address_columns(1 To 7) As String
    
    Dim notes_column As Integer
    notes_column = 78
    
    Dim notes(1 To 2) As String
    Dim current_row_first_name As String
    Dim current_row_last_name As String
    Dim next_row_first_name As String
    Dim next_row_last_name As String
    
    Dim address, address_column, address_a, address_b, next_row_address, current_row_address As Integer
    
    ' for each pair of adjacent contacts (sorted by first & last name)
    
    For current_row = first_row To last_row - 1
    
        ' for each pair of adjacent rows with same first & last names (same contact)
    
        current_row_first_name = Cells(current_row, first_name_column)
        current_row_last_name = Cells(current_row, last_name_column)
        next_row_first_name = Cells(current_row + 1, first_name_column)
        next_row_last_name = Cells(current_row + 1, last_name_column)
        If current_row_first_name = next_row_first_name And current_row_last_name = next_row_last_name Then
    
            ' concatenate the current & next row address columns
    
            For address = 1 To number_of_addresses
                For address_column = 1 To number_of_address_columns
                    current_row_address_columns(address_column) = Cells(current_row, first_address_column + (address - 1) * number_of_address_columns + address_column - 1).Value
                    next_row_address_columns(address_column) = Cells(current_row + 1, first_address_column + (address - 1) * number_of_address_columns + address_column - 1).Value
                Next
                current_row_addresses(address) = Join(current_row_address_columns, "$")
                next_row_addresses(address) = Join(next_row_address_columns, "$")
            Next
    
            ' remove any duplicate addresses in current row
            For address_a = 1 To number_of_addresses - 1
                For address_b = a + 1 To number_of_addresses
                    If current_row_addresses(address_a) = current_row_addresses(address_b) Then
                        current_row_addresses(address_b) = ""
                    End If
                Next
            Next
    
            ' remove any duplicate addresses from next row
    
            For next_row_address = 1 To number_of_addresses
                For current_row_address = 1 To number_of_addresses
                    If next_row_addresses(next_row_address) = current_row_addresses(current_row_address) Then
                        next_row_addresses(next_row_address) = ""
                        Exit For
                    End If
                Next
    
                ' move addresses from next row to empty addresses in current row or transfer to notes
    
                If next_row_addresses(next_row_address) <> "" Then
                    For current_row_address = 1 To number_of_addresses
                        If current_row_addresses(current_row_address) = "" Then
                            current_row_addresses(current_row_address) = next_row_addresses(next_row_address)
                            next_row_addresses(next_row_address) = ""
                            Exit For
                        End If
                    Next
                    If next_row_address <> "" Then
                        notes(1) = Cells(current_row, notes_column)
                        notes(2) = next_row_addresses(next_row_address)
                        Cells(current_row, notes_column) = Join(notes, " ")
                    End If
                End If
            Next
    
            ' refresh current & next row addresses
    
            For address = 1 To number_of_addresses
                current_row_address_columns = Split(current_row_addresses(address), "$")
                next_row_address_columns = Split(next_row_addresses(address), "$")
                For address_column = 1 To number_of_address_columns
                    Cells(current_row, first_address_column + (address - 1) * number_of_address_columns + address_column - 1) = current_row_address_columns(address_column)
                    Cells(current_row + 1, first_address_column + (address - 1) * number_of_address_columns + address_column - 1) = next_row_address_columns(address_column)
                Next
            Next
        End If
    Next
    End Sub
    The best way to debug this would be to output the values of 'address' and 'address_column' at the time of failure. My guess is that there's either a '$' missing or there's an extraneous '$' in current_row_addresses(address) or in next_row_addresses(address) which is giving you the error - more than likely the latter since it's that line that's failing. You really should check the UBound of the array after performing the Split to make sure it's in-bounds.
    BTW
    Code:
    Dim address, address_column, address_a, address_b, next_row_address, current_row_address As Integer
    is not doing what you think. Only current_row_address will be of Integer type, all the others will be Variants.
    Code:
    Dim address As Integer, address_column As Integer, address_a As Integer, address_b As Integer, next_row_address As Integer, current_row_address As Integer
    is what you need
    Last edited by Doogle; Sep 1st, 2012 at 02:31 AM.

  4. #4

    Thread Starter
    New Member
    Join Date
    Aug 2012
    Posts
    4

    Re: 'runtime error 9 subscript out of range' in xls macro

    many thanks doogle

    i've changed the dim statement which uncovered another error which i have corrected but the problem persists!

    debug shows that 'address column = 1' but 'next_row_address_columns(address_column) = <Subscript out of range>' - how can this be?

    something odd that i spotted is that, in previous lines, 'next_row_address = 4' (how can this be?) and thus 'next_row_addresses(next_row_address) = <Subscript out of range>' but the program runs through these lines OK!

    i've reattached the code (hopefully with indentation)
    Attached Files Attached Files

  5. #5
    PowerPoster
    Join Date
    Jul 2006
    Location
    Maldon, Essex. UK
    Posts
    6,334

    Re: 'runtime error 9 subscript out of range' in xls macro

    It's likely to be a problem created by this
    Code:
    next_row_address_columns = Split(next_row_addresses(address), "$")
    next_row_addresses(address) could be null
    or
    not have any "$" characters in it (which would give you only element 0)

    Suggest you check what's in next_row_addresses(address) when the problem happens.

  6. #6

    Thread Starter
    New Member
    Join Date
    Aug 2012
    Posts
    4

    Re: 'runtime error 9 subscript out of range' in xls macro

    thanks again Doogle

    i'm new to vb so it could be i'm not using arrays correctly - as i've defined 'next_row_addresses' as '1 to 3', i'm assuming that the only valid subscripts are 1,2 & 3?

    i may have misprogrammed the logic but, as i've previously unconditionally joined the 3 sets of 7 address columns with '$' characters (which shouldn't appear in address information!), i should be able to subsequently split them back into their constituent columns.......................

    if anyone can spot the flaw in the logic, i'd be extremely grateful!

  7. #7
    PowerPoster
    Join Date
    Jul 2006
    Location
    Maldon, Essex. UK
    Posts
    6,334

    Re: 'runtime error 9 subscript out of range' in xls macro

    I can see something 'suspicious' where you are removing Duplicates. It looks as if you're looking at two consecutive elements and if they're equal setting the second one to Null. When you subsequently Join you're going to end up with null elements. Not sure if you've coded for that possibility.
    Here's a simple example of what I mean
    Code:
    Dim strA(3) As String
    Dim strZ As String
    strA(0) = "AAAA"
    strA(1) = ""
    strA(2) = "BBBB"
    strA(3) = "CCCC"
    strZ = Join(strA, "$")
    Debug.Print strZ
    If you run this you'll see the output is
    Code:
    AAAA$$BBBB$CCCC
    Obviously, when you subsequently Split the string you'll end up with a Null in the second element of the array.

    You may be better off constructing a "$" delimited string when removing duplicates, this would avoid having to Join and also remove the 'Null' problem.
    Code:
    Dim strA(5) As String
    Dim strZ As String
    Dim strX As String
    Dim intI As Integer
    strA(0) = "AAAA"
    strA(1) = "AAAA"
    strA(2) = "BBBB"
    strA(3) = "CCCC"
    strA(4) = "CCCC"
    strA(5) = "CCCC"
    Do
        If strA(intI) = strA(intI + 1) Then
            strX = strX & strA(intI) & "$"
            intI = intI + 2
        Else
            strX = strX & strA(intI) & "$"
            intI = intI + 1
        End If
    Loop Until intI > UBound(strA) - 1
    strX = Left$(strX, Len(strX) - 1)
    Debug.Print strX
    This will produce a string (strX) based upon the contents of strA() with the duplicates removed:
    Code:
    AAAA$BBBB$CCCC
    which you could subsequently Split and process.

    EDIT: Note that this only works if the Array is sorted, but I think I saw in a comment that it was.
    Last edited by Doogle; Sep 3rd, 2012 at 02:31 AM.

  8. #8
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    2,203

    Re: 'runtime error 9 subscript out of range' in xls macro

    I really don't have the time to try out all the codes here, but i'll tell you how i'm doing tasks such as this (removing duplicates from a sorted list) without any issues.

    The trick is: You have to iterate through your list backwards!

    Code:
    For i=LastRow to FirstRow Step -1
    
    if MyAdress(i)=MyAdress(i-1) then
    RemoveAdress(i)
    End If
    
    Next
    Advantage: You don't have to keep an eye on the length of your List since you're deleting an item which has already been counted!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width