Excel Forum

Code: Select all

Private Sub CommandButton1_Click()
    Dim rAll As Range, r As Range
    Dim rTgAll As Range, i As Integer
    Dim d As Object, arr As Variant
    
    Set d = VBA.CreateObject("Scripting.Dictionary")
    With Worksheets("Sheet1")
        Set rAll = .Range("B2:HV21")
        For Each r In rAll
            If r.Value <> "" Then
                If Not d.exists(r.Value) Then
                    d.Add Key:=r.Value, Item:=r.Value
                End If
            End If
        Next r
    End With

    i = 0
    With Worksheets("Sheet1")
        Set rTgAll = .Range("HX2:IS1000")
        rTgAll.ClearContents
        arr = d.keys
        For Each r In rTgAll
            rTgAll(i + 1).Value = arr(i)
            i = i + 1
            If i > UBound(arr) Then Exit For
        Next r
    End With
End Sub