Snasui Excel Forum

Code: Select all

Dim dic As Object
Dim i As Long, r As Range
Dim InputRng As Variant, OutRng
Dim a(0 To 999, 0 To 2) As Variant
Set InputRng = Application.InputBox("Select the range of cells", Type:=8)
Set OutRng = Application.InputBox("Out put to cell ", Type:=8)
Set dic = CreateObject("Scripting.Dictionary")
'For i = 1 To UBound(InputRng)
'    If InputRng <> "" Then dic(InputRng(i, 1)) = 1
'Next i
For Each r In InputRng
    If Not dic.exists(CStr(r.Value)) Then
        dic.Add Key:=CStr(r.Value), Item:=CStr(r.Value)
        a(i, 0) = i + 1
        a(i, 1) = r.Offset(0, -1).Value
        a(i, 2) = r.Value
        i = i + 1
    End If
Next r
OutRng.Resize(i, 3) = a