CODEWITHSUNDEEP
arraysexcelvba
user2242044
user2242044

Reputation: 9253

Deleting duplicates in a VBA Array

CODE WORKS CORRECTLY. MODIFIED BASED ON HELP FROM RESPONSES.

I have the following code to remove duplicates from a array, MyArray. The code gets a debugging error at: d(MyArray(i)) = 1. The error is subscript out of range. Not sure what is causing this and what is wrong with my code.

Sub DataStats1()
Dim Range1 As Range
Dim MyArray As Variant

Set Range1 = Application.InputBox("Select Range1:", Title:="Set Data Range", Type:=8)

Range1.Select
MyArray = Application.Transpose(Application.Transpose(Range1.Value))



Dim d As Object
Set d = CreateObject("Scripting.Dictionary")

For Each el In MyArray
   d(el) = 1
Next

Dim v As Variant
v = d.Keys()


For i = 1 To UBound(v)
MsgBox v(i)
Next i
End Sub

Upvotes: 3

Views: 8544

Answers (2)

David Zemens
David Zemens

Reputation: 53663

You should learn to stop relying on Selection (this is after all why you have declared your variables...). You can do MyArray = Range1.Value instead.

Now, a Range Array is always going to be 2-dimensional, you instead of that, you will acutally need to do this if you are selecting a COLUMN range:

MyArray = Application.Transpose(Range1.Value)

Or this, if you are selecting a ROW range:

MyArray = Application.Transpose(Application.Transpose(Range1.Value)

You may need to do other operations if it is multi-dimensional range. I haven't tested.

Here are some ideas:

Sub DataStats1()
Dim Range1 As Range
Dim MyArray As Variant
Dim v As Variant
Dim d As Object

Set Range1 = Application.InputBox("Select Range1:", Title:="Set Data Range", Type:=8)

MyArray = Application.Transpose(Application.Transpose(Range1.Value))

Set d = CreateObject("Scripting.Dictionary")

For Each el In MyArray
   d(el) = 1
Next

'## Assign the Keys to an array:
v = d.Keys

'## At this point, v is an array of unique values.
'   Do whatever you want with it:
'
'Print the list to a COLUMN new sheet:
Sheets.Add
Range("A1").Resize(UBound(v) + 1).Value = Application.Transpose(v)


'Or print the list to a msgBox:
MsgBox Join(v, ", ")

'Or print to the console:
Debug.Print Join(v, ", ")

End Sub

Upvotes: 2

brettdj
brettdj

Reputation: 55712

Something like this (for a single column or single row given you use Transpose)

Sub DataStats1()
Dim Rng1 As Range
Dim MyArray As Variant
Dim MyArray2 As Variant
Dim el
Dim d As Object

On Error Resume Next
Set Rng1 = Application.InputBox("Select Range1:", Title:="Set Data Range", Type:=8)
On Error GoTo 0

If Rng1 Is Nothing Then Exit Sub

MyArray = Application.Transpose(Application.Transpose(Rng1.Value))
Set d = CreateObject("Scripting.Dictionary")

For Each el In MyArray
If Not d.exists(el) Then d.Add el, 1
Next

MyArray2 = d.items

End Sub

Upvotes: 1

Related Questions