Tri des dates et afficher la plus récente

Bonjour j'ai le tableau suivant:

Je dois afficher les informations des lignes 20, 21, 22 dans une listbox avce ce code:

Private sub cb_click() 
Set ws = ActiveWorkbook.Worksheets(Personne)
fin_col_Habilit = ws.Cells(20, 256).End(xlToLeft).Column
UF_Profil_Edit1.ListBox_Habilit.ColumnCount = 3
UF_Profil_Edit1.ListBox_Habilit.ColumnWidths = "150;150;150"
For i = 2 To fin_col_Habilit
UF_Profil_Edit1.ListBox_Habilit.AddItem ws.Cells(20, i)
UF_Profil_Edit1.ListBox_Habilit.List(UF_Profil_Edit1.ListBox_Habilit.ListCount - 1, 1) = ws.Cells(21, i)
UF_Profil_Edit1.ListBox_Habilit.List(UF_Profil_Edit1.ListBox_Habilit.ListCount - 1, 2) = ws.Cells(22, i)
Next i
tri_Habi
end sub 

Avec tri_Habi est le résultat deu tri des lignes 16 et 17 pour prendre seulement les formation avec les dates les plus récentes et les afficher dans une listbox en utilisant ce code:

Private Sub tri_Habi() 'tri les habilitations par dates et recuperer les plus recentes dans la ligne 20 et 21
Dim dercol As Long, t, i As Long, j As Long, dico, x, ech As Boolean

With ActiveWorkbook.Worksheets(Personne)

      'lecture du tableau des formations
      dercol = .Cells(16, .Rows.Columns.Count).End(xlToLeft).Column
      t = Application.Transpose(.Range("16:17").Resize(, dercol).Value2)

      'tri de t sur la première colonne (numéro de foemation) sans les en-têtes
      Do
         ech = False
         For i = 2 To UBound(t) - 1
            If t(i + 1, 1) < t(i, 1) Then
               x = t(i, 1): t(i, 1) = t(i + 1, 1): t(i + 1, 1) = x
               x = t(i, 2): t(i, 2) = t(i + 1, 2): t(i + 1, 2) = x: ech = True
            End If
         Next i
      Loop Until Not ech

      ' conversion des numéros en texte (pour le dico et la listbox)
      ' et les fausses dates (en texte) en vraies dates
      On Error GoTo PasDate
      For i = 2 To UBound(t)
         t(i, 1) = CStr(t(i, 1))
         If TypeName(t(i, 2)) = "String" Then t(i, 2) = 1 * DateSerial(Right(t(i, 2), 4), Mid(t(i, 2), 4, 2), Left(t(i, 2), 2))
      Next i
      On Error Resume Next

      'remplissage de dico
      Set dico = CreateObject("scripting.dictionary")
      dico.CompareMode = TextCompare
      For i = 2 To UBound(t)
         If t(i, 1) <> "" Then
            If Not dico.Exists(t(i, 1)) Then
               dico.Add t(i, 1), t(i, 2)
            Else
               If t(i, 2) > dico(t(i, 1)) Then dico(t(i, 1)) = t(i, 2)
            End If
         End If
      Next i

   'Transfert de dico vers le tableau r pour la liste
   ReDim r(1 To dico.Count, 1 To 2): i = 0
   For Each x In dico.Keys: i = i + 1: r(i, 1) = x: r(i, 2) = dico(x): Next

   'remplissage des lignes 10 et 11 de la feuille PERSONNE
   .Range("b20:b21").Resize(, Columns.Count - 1).Clear
'   .Range("b13").Resize(1, UBound(r)).NumberFormat = "000"
   .Range("b20").Resize(1, UBound(r)).HorizontalAlignment = xlCenter
   .Range("b21").Resize(1, UBound(r)).NumberFormat = "dd/mm/yyyy"
   .Range("b20").Resize(2, UBound(r)).Borders.LineStyle = xlContinuous
   .Range("b20:b21").Resize(2, UBound(r)) = Application.Transpose(r)

   End With

   'remplissage de la listbox
    For i = 1 To UBound(r): r(i, 1) = Format(r(i, 2), "dd/mm/yyyy"): Next

   'For i = 1 To UBound(r): r(i, 1) = Format(r(i, 1), "000"): r(i, 2) = Format(r(i, 2), "dd/mm/yyyy"): Next

   With ListBox1
      .ColumnCount = 2
      .ColumnHeads = False
      .ColumnWidths = .Width * 0.7        '& ";" & .Width * (1 - 0.6 + 0.1)
      .List = r
   End With
   Exit Sub

'
PasDate:
Exit Sub
   End
End Sub

Je veux modifier le code de telle sorte faire le tri des lignes 16,17 et 18 pour que je puisse afficher la date de validité, la je suis bloquée je sais pas cmn proceder.

Merci pour vos propositions.