Filter Unique Values and Sort A to Z then Paste the Result

[ExcelMentee]

I have been using below code to Filter the Unique values from Sheet1 and paste them into Sheet2 my code is working fine. But it has one issue that is when i remove any value from Sheet1.Range(C4:C) cell it gives empty cell in Sheet2 like in below image.

I want that if i remove any cell value from Sheet1 range then Code should automatically adjust it. there should not be any empty cell in Sheet2 Range.

I also wants to add sort function in the code so unique values will be popup with sorting A to Z in sheet2.

I tried at my end to do both things but cannot do. Your help in this regard will be highly appreciated.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
c = Sheet1.Range("C4:C" & lr)
For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1
Next i
Sheet2.Range("C4").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

 

[Fluff]

As you are using 365, why not just use a simple formula

=SORT(UNIQUE(FILTER(Sheet1!C2:C10000,Sheet1!C2:C10000<>"")))

 

[mart37]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d As Object, c As Variant, i As Long, lr As Long
    Dim lst As Object
    Set d = CreateObject("Scripting.Dictionary")
    Set lst = CreateObject("System.Collections.Sortedlist")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    c = Sheets(1).Range("C4:C" & lr)
    For i = 1 To UBound(c, 1)
        If c(i, 1) <> "" Then d(c(i, 1)) = 1
    Next i
    myUniqueList = Application.Transpose(d.keys)
    With lst
        For i = 1 To UBound(myUniqueList)
            .Add myUniqueList(i, 1), i
        Next
        For i = 0 To .Count - 1
              Sheets(2).Range("C" & i + 4) = .GetKey(i)
        Next
    End With
End Sub

 

[ExcelMentee]

Many thanks for the solution.

Fluff​

but m looking for VBA solution as well.

 

[Fluff]

In that case how about

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Cl As Range

   If Not Intersect(Target, Range("C:C")) Is Nothing Then
      With CreateObject("system.collections.arraylist")
         For Each Cl In Range("C4", Range("C" & Rows.Count).End(xlUp))
            If Cl.Value <> "" Then
               If Not .contains(Cl.Value) Then .Add Cl.Value
            End If
         Next Cl
         .Sort
         Sheet2.Range("C4").Resize(.Count).Value = Application.Transpose(.toarray)
      End With
   End If
End Sub

 

[ExcelMentee]

Fluff​

Thank you so much. I have been stunned by looking at your code that how short it is and working perfectly

mart37​

Thank you for the answer. Bu your code just loads these two values instead of all from Sheet1 Col "C"

 

[Fluff]

Glad we could help & thanks for the feedback.