Find value in column within last 90 days & populate listbox

[ipbr21054]

Morning,

On my worksheet i wish to look for the value TBA but only for the last 90 days
Any TBA found after 90 days can be ignored.

Here is how it should work,

In column G will be various values BUT i am looking for TBA only.
In column A will be a date.
In column B will be a Customers Name.

I would have a userform with Listbox1 & a command button.
The command button would run the code looking for TBA & Customers found within last 90 days would then appear in my Listbox.

Please can you advise Thanks

 

[ipbr21054]

I managed to find another code which works but can you havise how i edit the line shown from row mentioned to last 90 days>

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 = 7
        .ColumnWidths = "170;260;220;130;130;80;50"
10
        [COLOR=rgb(184, 49, 47)]Set r = Range("A2155", Range("G" & Rows.count).End(xlUp)) ' THIS IS THE ROW NUMBER TO SEARCH DOWN FROM[/COLOR]
       
        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, 3) = f.Offset(, -6).Value  'DATE
              .List(i, 4) = f.Offset(, -2).Value  'TRACKING NUMBER
              .List(i, 5) = f.Row                 'ROW
              .List(i, 6) = f.Offset(, 5).Value  'ROYAL MAIL CLAIM
             
              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, 3) = f.Offset(, -6).Value  'DATE
          .List(.ListCount - 1, 4) = f.Offset(, -2).Value  'TRACKING NUMBER
          .List(.ListCount - 1, 5) = f.Row                 'ROW
          .List(.ListCount - 1, 5) = f.Offset(, 4).Value  'ROYAL MAIL CLAIM
         
        End If

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

 

[NoSparks]

I'd ignore that function and use something along the lines of this

Private Sub CommandButton1_Click()
    Dim fndRng As Range
    Dim firstAddress As String
    
With Me.ListBox1
    .ColumnCount = 7
    .ColumnWidths = "170;260;220;130;130;80;50"
End With

With Sheets("POSTAGE").Range("G:G")
    Set fndRng = .Find(What:="TBA", LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not fndRng Is Nothing Then
        firstAddress = fndRng.Address
        Do
            ' check the date
            If fndRng.Offset(, -6).Value > Date - 90 Then
                ' add to listbox
                With Me.ListBox1
                    .AddItem fndRng.Offset(, -5).Value                      'NAME
                    .List(.ListCount - 1, 1) = fndRng.Offset(, -6).Value    'DATE
                    .List(.ListCount - 1, 2) = fndRng.Offset(, -4).Value    '
                    .List(.ListCount - 1, 3) = fndRng.Offset(, -3).Value    '
                    .List(.ListCount - 1, 4) = fndRng.Offset(, -2).Value    '
                    .List(.ListCount - 1, 5) = fndRng.Offset(, -1).Value    '
                    .List(.ListCount - 1, 6) = fndRng.Value                 'TBA
                End With
            End If
            Set fndRng = .FindNext(fndRng)
        Loop While Not fndRng Is Nothing And fndRng.Address <> firstAddress
    End If
End With
End Sub

 

[ipbr21054]

Thanks will take a look

 

[ipbr21054]

Just a 1am thought & will look at this code advised above tomorrow.

Might need to but not sure yet edit the code so it looks for the value After 30 days & before 90 days.

Also if no values are found / shown in listbox have a Msgbox pop up advising user no value were found etc.

Thanks.

 

[ipbr21054]

This is what i currently have in use.
TBA has been changed to RECEIVED NO DATE

When i run the code it checks all the way back to 2021 as opposed 90 days from todays date
Do you see an issue as to why.

Worksheet info
Column G is where we look for RECEIVED NO DATE
Column A is the date
Column B is the customers name

Private Sub CloseForm_Click()
Unload RoyalMailClaim
End Sub

Private Sub ListBox1_Click()
  Range("A" & ListBox1.List(ListBox1.ListIndex, 5)).Select
  Unload RoyalMailClaim
End Sub

Private Sub RunCode_Click()
    Dim fndRng As Range
    Dim firstAddress As String
    
With Me.ListBox1
    .ColumnCount = 7
    .ColumnWidths = "220;200;110;140;70;70;100"
End With

With Sheets("POSTAGE").Range("G:G")
    Set fndRng = .Find(What:="RECEIVED NO DATE", LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not fndRng Is Nothing Then
        firstAddress = fndRng.Address
        Do
            ' check the date
            If fndRng.Offset(, -6).Value > Date - 90 Then
                ' add to listbox
                With Me.ListBox1
                    .AddItem fndRng.Offset(, -5).Value                      'CUSTOMER
                    .List(.ListCount - 1, 1) = fndRng.Offset(, -4).Value    'ITEM
                    .List(.ListCount - 1, 2) = fndRng.Offset(, -6).Value    'DATE
                    .List(.ListCount - 1, 3) = fndRng.Offset(, -2).Value    'TRACKING NUMBER
                    .List(.ListCount - 1, 4) = fndRng.Offset(, 5).Value     'CLAIM
                    .List(.ListCount - 1, 6) = fndRng.Value                 'TBA
                    
                    
                End With
            End If
            Set fndRng = .FindNext(fndRng)
        Loop While Not fndRng Is Nothing And fndRng.Address <> firstAddress
    End If
End With
End Sub

 

[NoSparks]

Are you saying that running this macro today (October 24, 2024) the list box contain dates that are prior to July 26, 2024 ?

you say "When i run the code it checks all the way back to 2021 as opposed 90 days from todays date"
How do you know that other than it being applied to the entire column ?

 

[ipbr21054]

I run the code today & as opposed the listbox having say 30 values it has more like 130
Looking at some dates they are 2021
The listbox has a column for where it shows me various values & one being dates.

I also started another post as when I click on the listbox entry as opposed to be taken to that customer in the worksheet it errors.
The other post explains.

Thanks

 

[ipbr21054]

See example.

 

[NoSparks]

try

            If Date - fndRng.Offset(, -6) < 90 Then