Date formula not applied the same to all Listbox entries

[ipbr21054]

The code is shown below but as you can see by the screenshot it doesnt apply itself the same to all entries.
Value on worksheet is 13/06/2024 & 10/06/2024 same as all other dates

Private Function add_val(A As String)
    
      Dim r As Range, f As Range, Cell As String, added As Boolean
      Dim sh As Worksheet
      
      Set sh = Sheets("POSTAGE")
      sh.Select
      With ListBox1
        
        .ColumnCount = 5
        .ColumnWidths = "170;260;220;130;30"

        Set r = Range("G2183", Range("G" & Rows.count).End(xlUp)) ' THIS IS THE ROW NUMBER TO SEARCH DOWN FROM
        
        Set f = r.Find(A, LookIn:=xlValues, LookAt:=xlPart)
        If Not f Is Nothing Then
          Cell = f.Address
          Do
            added = False
            For i = 0 To .ListCount - 1
              Select Case StrComp(.List(i), f.Value, vbTextCompare)
                Case 0, 1
              .AddItem f.Value, i                 'POSTAL ISSUE COLUMN
              .List(i, 1) = f.Offset(, -5).Value  'CUSTOMER
              .List(i, 2) = f.Offset(, -4).Value  'ITEM
              .List(i, 3) = Format(f.Offset(, -6).Value, "dd/mm/yyyy") 'DATE
              .List(i, 4) = f.Row                 'ROW
              added = True
              Exit For
          End Select

            Next
            If added = False Then
          .AddItem f.Value                                 'POSTAL ISSUE COLUMN
          .List(.ListCount - 1, 1) = f.Offset(, -5).Value  'CUSTOMER
          .List(.ListCount - 1, 2) = f.Offset(, -4).Value  'NAME
          .List(.ListCount - 1, 3) = f.Offset(, -6).Value  'DATE
          .List(.ListCount - 1, 4) = f.Row                 'ROW
        End If

            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> Cell
        Else
        End If
      End With
End Function

Private Sub UserForm_Initialize()

Application.ScreenUpdating = False

On Error GoTo End_here

Call add_val("LOST")
Call add_val("DELIVERED NO SIG")
Call add_val("RETURNED")
Call add_val("UNKNOWN")

End_here: Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

The format needs to be applied to the second line:

Private Function add_val(A As String)
    
      Dim r As Range, f As Range, Cell As String, added As Boolean
      Dim sh As Worksheet
      
      Set sh = Sheets("POSTAGE")
      sh.Select
      With ListBox1
        
        .ColumnCount = 5
        .ColumnWidths = "170;260;220;130;30"

        Set r = Range("G2183", Range("G" & Rows.Count).End(xlUp)) ' THIS IS THE ROW NUMBER TO SEARCH DOWN FROM
        
        Set f = r.Find(A, LookIn:=xlValues, LookAt:=xlPart)
        If Not f Is Nothing Then
          Cell = f.Address
          Do
            added = False
            For i = 0 To .ListCount - 1
              Select Case StrComp(.List(i), f.Value, vbTextCompare)
                Case 0, 1
              .AddItem f.Value, i                 'POSTAL ISSUE COLUMN
              .List(i, 1) = f.Offset(, -5).Value  'CUSTOMER
              .List(i, 2) = f.Offset(, -4).Value  'ITEM
              .List(i, 3) = Format(f.Offset(, -6).Value, "dd/mm/yyyy") 'DATE
              .List(i, 4) = f.Row                 'ROW
              added = True
              Exit For
          End Select

            Next
            If added = False Then
          .AddItem f.Value                                 'POSTAL ISSUE COLUMN
          .List(.ListCount - 1, 1) = f.Offset(, -5).Value  'CUSTOMER
          .List(.ListCount - 1, 2) = f.Offset(, -4).Value  'NAME
          .List(.ListCount - 1, 3) = Format(f.Offset(, -6).Value, "dd/mm/yyyy")  'DATE
          .List(.ListCount - 1, 4) = f.Row                 'ROW
        End If

            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> Cell
        Else
        End If
      End With
End Function

 

[ipbr21054]

Many Thanks
We did add a format to the line above but only did a few dates in Listbox