Gather data for Listbox only after a certain date

[ipbr21054]

Morning,
The code in use is shown below.
Currently it populates my Listbox with values mentioned below from my Database.
After now using it for a while there are dates which go back as far as 2021

Im looking to be able to add a date within the code so my Listbox is only populated AFTER that date.
This will then make the results in the Listbox much smaller than it currently is.


Value like LOST, RECEIVED NO DATE etc etc are all in column G
The date is in the same row & in column A



Many Thanks

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 = 4
        .ColumnWidths = "170;260;220;10"

        Set r = Range("G8", Range("G" & Rows.Count).End(xlUp))
       
        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  'NAME
              .List(i, 2) = f.Offset(, -4).Value  'ITEM
              .List(i, 3) = f.Offset(, -6).Value  '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  'NAME
          .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("RECEIVED NO DATE")
Call add_val("RETURNED")
Call add_val("UNKNOWN")

End_here: Application.ScreenUpdating = True
End Sub

 

[ipbr21054]

Just a thought that it might be easier if the code was to just look from row 1658 then down the page

 

[ipbr21054]

Sorry my mistake,

Looking at the code again i spotted this.

Set r = Range("G8", Range("G" & Rows.Count).End(xlUp))