I am not able create array and there is something wrong with my remove duplicates also

Question

Please see the attachment for understanding the output of my query (I have mentioned header in the image for your understanding by in actual, header is blank for the output).

My code runs only for first iteration of k and then I get the error "Subscript out of range at the line mentioned below. Also, my remove duplicates is not giving the required output in the code. is it because of blank spaces or what and how can I resolve these two issues?

I am using arrays for the very first time.

Dim MoNameArr
Dim arr()
Dim ColLtrg, ColLtrgp, GPLLastCol, GPLLastRow as Long
i = 0
ReDim arr(0)

With wsg

    For k = 2 To GPLLastRow

        .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value

        If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
            i = k - 2
            arr(i) = .Cells(k, 2).Value 'Subscript out of range error
            .Cells(k, GPLLastCol + 2).Value = arr(i)
            ReDim Preserve arr(i)
        End If

    Next k

    ColLtrg = Replace(.Cells(1, GPLLastCol + 2).Address(True, False), "$1", "")

    .Range(ColLtrg & "1:" & ColLtrg & GPLLastRow).RemoveDuplicates Columns:=1, Header:=xlNo
    MoNameArr = .Range("AD1:AD" & GetLastRow(wsg, GPLLastCol + 2))

End With

For Each Item In MoNameArr
    'Do something
Next Item


Public Function GetLastCol(ByVal ws As Worksheet, rowNum As Long) As Long
  With ws
    GetLastCol = .Cells(rowNum, Columns.Count).End(xlToLeft).Column
  End With
End Function

Public Function GetLastRow(ByVal ws As Worksheet, colNum As Long) As Long
  With ws
    GetLastRow = .Cells(Rows.Count, colNum).End(xlUp).Row
  End With
End Function

Whosoever has downvoted, kindly provide the reason if you can't provide the solution. I am learning vba and have encountered arrays for the first time(working on my second assignment anyway) and I am not able to figure out lots of stuffs by reading articles related to array. — HobbyCoder, Apr 21 '18 at 10:45
Just wanted to note: this statement: `Dim ColLtrg, ColLtrgp, GPLLastCol, GPLLastRow as Long` is only declaring the `GPLLastRow` as a `Long`. The others are defaulting to `Variant`. — Mistella, Apr 21 '18 at 15:50

Mistella · Accepted Answer · 2018-04-21T15:47:35.303

The subscript out of range error is most likely from how you defined your array to the Application. I feel pretty confident that when you're getting that error, i <> 0.

Note:

When using ReDim Preserve arr(i), you need to declare this before attempting to put a variable in arr(i). Also, since i is based off of k, which is related to the cell reference, your array will result in a number of empty item slots in between the values you decide to keep.

Explanation

In this line:

ReDim arr(0)

You are telling the Application to define arr as a single dimension array with an upper boundary of 0 Since the default lower boundary is usually 0, as well; you are essentially telling the Application to define the array with room for 1 object.

Which would be accessed via the codearr(0)

If you had used the following line:

ReDim arr(1 to 10)

You would be telling the Application to define the array as single-dimensional, with room for 10 objects, the first being accessed via arr(1) and the last via arr(10).

This next line would also define the array as single dimensional, with 10 objects:

ReDim arr(9)

However, this time, the first object can be accessed via arr(0) and the last via arr(9). (This is based on the assumption that you haven't declared in your vba that the default lower bound should be 1.)

You could define a two dimensional array like so:

ReDim arr(0 to 5, 0 to 15)

This array would hold 96 items. However, to access them, you would have to use code like arr(0,4) or arr(2,15).

Alternative Option

If I may recommend an alternative method, have you considered using a dictionary object instead of an array?

Since I do not know all that you may be doing with your data, this may not be the best solution. However, if you're main goal is to remove duplicate values from, and condense, a column, I think a dictionary should work rather well.

This Q/A on stackoverflow has some good basic information on dictionaries vs collections vs arrays.

The main reason I'm thinking dictionary, is because dictionary objects have an .Exists method in which you can pass a value (as a key) and see if the dictionary already has it. Then you can add any new items and ignore duplicate ones.

Assuming dict is a dictionary object and rng is the looping variable cell/range object you are checking, you could use the following code to collect a list of distinct values and counts:

For each rng in SomeRangeVariable
    With dict
        If .Exists(rng.Value) Then
            .Items(rng.Value) = .Items(rng.Value) + 1
        Else
            .Add Key:=rng.Value, Item:=1
        End If
    End With
Next rng

score 1 · Answer 2 · answered Apr 21 '18 at 21:17

You instantiate the zero-based 1-D array arr with a single element; e.g. arr(0 to 0).

On the first iteration of your loop, k is 2 and i = k - 2 so i is zero. There is room in the array for the .Cells(k, 2) value if the conditions are met.

The ReDim statement does nothing here since i is zero and ubound(arr) is already zero.

On the next iteration and everyone after until the condition is met, ubound(arr) is still zero but k has grown and since i is based on k, it grows as well. Any attempt to put the .Cells(k, 2) value into arr at position i will result in 'Subscript out of range'.

Solution: Redim with Preserve before attempting to populate the array.

For k = 2 To GPLLastRow
    .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value
    If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
        i = k - 2
        ReDim Preserve arr(i)
        arr(i) = .Cells(k, 2).Value 'Subscript not out of range anymore
        .Cells(k, GPLLastCol + 2).Value = arr(i)
    End If
Next k

HobbyCoder · Answer 3 · 2018-04-23T03:29:33.943

Thank you so much Jeeped and Mistella for in-depth explanation and for making me realise loop-holes in my code. I am now able to do it using 2 ways. One with arrays and one without arrays.Can't say if anyone of these is better than the other but they both work for me.I will try the dictionary method also later.

'Method using arrays/Redim preserve

i = 0
With wsg
    For k = 2 To GPLLastRow
    On Error Resume Next 'For handling #N/A values
        .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value
        If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
            ReDim Preserve arr(i)
            arr(i) = .Cells(k, 2).Value 'Subscript not out of range anymore
            .Cells(i + 1, GPLLastCol + 2).Value = arr(i)
            i = i + 1
        End If
    On Error GoTo 0
    Next k

    ColLtrgp = Replace(.Cells(1, GPLLastCol + 1).Address(True, False), "$1", "")
    ColLtrg = Replace(.Cells(1, GPLLastCol + 2).Address(True, False), "$1", "")

    .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2)).RemoveDuplicates Columns:=1, Header:=xlNo
    MoNameArr = .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2))
End With

'Method without using arrays/Redim preserve

i = 1
With wsg
    For k = 2 To GPLLastRow
    On Error Resume Next
        .Cells(k, GPLLastCol + 1).Value = .Cells(k, 2).Value & .Cells(k, 3).Value
        If .Cells(k, 4).Value = .Cells(k, 8).Value And .Cells(k, 4).Value = .Cells(k, 9).Value Then
            .Cells(i, GPLLastCol + 2).Value = .Cells(k, 2).Value
            i = i + 1
        End If
    On Error GoTo 0
    Next k

    ColLtrgp = Replace(.Cells(1, GPLLastCol + 1).Address(True, False), "$1", "")
    ColLtrg = Replace(.Cells(1, GPLLastCol + 2).Address(True, False), "$1", "")

    .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2)).RemoveDuplicates Columns:=1, Header:=xlNo
    MoNameArr = .Range(ColLtrg & "1:" & ColLtrg & GetLastRow(wsg, GPLLastCol + 2))
End With

I am not able create array and there is something wrong with my remove duplicates also

3 Answers3