Reputation: 9253
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
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
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