filter unique values and sort A to Z Excel VBA

Question

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

question from:https://stackoverflow.com/questions/65900852/filter-unique-values-and-sort-a-to-z-excel-vba

Answer 1

This is the code I've used:

Sub test()
Dim WkSource As Worksheet
Dim WkDestiny As Worksheet
Dim MiMatriz() As Variant
Dim LR As Long
Dim i As Long
Dim ZZ As Long

Set WkSource = ThisWorkbook.Worksheets("source") 'Replace SOURCE with name of your Sheet1
Set WkDestiny = ThisWorkbook.Worksheets("destiny") 'Replace DESTINY with name of your sheet2

With WkSource
    LR = .Cells(.Rows.Count, 3).End(xlUp).Row 'Last non empty cell in colum C
    ReDim MiMatriz(1 To LR - 4 + 1) 'we do LR-4 because your data starts at row 4, and we add 1
    ZZ = 1
    For i = 4 To LR Step 1
        MiMatriz(ZZ) = .Range("C" & i).Value
        ZZ = ZZ + 1
    Next i
End With

'sort
Call QuickSort(MiMatriz, 1, UBound(MiMatriz))

'paste

'we paste array, excluding blanks
ZZ = 4 'starting at row 4
For i = 1 To UBound(MiMatriz) Step 1
    If MiMatriz(i) <> "" Then
        WkDestiny.Range("C" & ZZ).Value = MiMatriz(i)
        ZZ = ZZ + 1
    End If
Next i


'Remove duplicates
WkDestiny.Range("C4:C" & ZZ - 1).RemoveDuplicates Columns:=1, Header:=xlNo

Erase MiMatriz
Set WkSource = Nothing
Set WkDestiny = Nothing

End Sub

You'll need also this UDF to sort arrays:

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi)  2)

  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

My source sheet (your Sheet1) is:

And when executing code, in my destiny sheet (your sheet2) I get:

All data sorted and no blanks :)

Hope you can adapt this to your needs.

about function to sort arrays, all credits go to author: https://stackoverflow.com/a/152325/9199828