Populate ListBox1 with rows that have expired dates in.

[KyleJackMorrison]

Hello,

I have a complex sheet that has hundreds of employee's on who have completed courses.

As each month i have to give a list of name to my boss about whose course has been expired (Courses last 2 years). I have the userform all set up, however i can't seem to get the code to search and populate the list box with only people who have been expired.

Here's what my sheet looks like:

Title	Name	ID No.	Course 1
Mr	Joe	22334455	01/01/2017
Miss	Mary	11223344	10/10/2014
Mr	Smith	99887766	01/01/2012

<tbody>
</tbody>

As you can see, i would like the listbox1 to display Miss Mary and Mr Smith as their courses have expired past 2 years.

Any help is much appreciated!

KJM

 

[Fluff]

How about

Private Sub UserForm_Initialize()

    Dim Cl As Range
    Dim Rng As Range
    
    With Sheets("[COLOR=#ff0000]Details[/COLOR]")
        For Each Cl In .Range("D2", .Range("D" & Rows.Count).End(xlUp))
            If Cl.Value < Date - 730 Then
                If Rng Is Nothing Then
                    Set Rng = .Range("A" & Cl.Row).Resize(, 3)
                Else
                    Set Rng = Union(Rng, .Range("A" & Cl.Row).Resize(, 3))
                End If
            End If
        Next Cl
    End With
    
    ListBox1.list = Rng.Value

End Sub

Change sheet name to suit.
This also assumes your dates are in Col D starting in row 2

 

[Rick Rothstein]

How about

Private Sub UserForm_Initialize()

    Dim Cl As Range
    Dim Rng As Range
    
    With Sheets("Details")
        For Each Cl In .Range("D2", .Range("D" & Rows.Count).End(xlUp))
            If Cl.Value < [B][COLOR="#FF0000"][SIZE=2]Date - 730[/SIZE][/COLOR][/B] Then
                If Rng Is Nothing Then
                    Set Rng = .Range("A" & Cl.Row).Resize(, 3)
                Else
                    Set Rng = Union(Rng, .Range("A" & Cl.Row).Resize(, 3))
                End If
            End If
        Next Cl
    End With
    
    ListBox1.list = Rng.Value

End Sub

Change sheet name to suit.
This also assumes your dates are in Col D starting in row 2

If you wanted to be perfectly accurate (your code could be off by one day if a leap year occurred within the 2 year period), you could replace the red highlighted part of your code with this...

DateAdd("yyyy", -2, Date)

 

[Fluff]

@Rick Rothstein
As always, an excellent point, well made.
@KyleJackMorrison
Please ignore my code, I've just realised it doesn't fully work

 

[Fluff]

Try this instead

Private Sub UserForm_Initialize()

    Dim Cl As Range
    Dim Rng As Range
    Dim Ar As Range
    Dim Rw As Range
    
    
    With Sheets("Details")
        For Each Cl In .Range("D2", .Range("D" & Rows.Count).End(xlUp))
            If Cl.Value < DateAdd("yyyy", -2, Date) Then
                If Rng Is Nothing Then
                    Set Rng = .Range("A" & Cl.Row).Resize(, 3)
                Else
                    Set Rng = Union(Rng, .Range("A" & Cl.Row).Resize(, 3))
                End If
            End If
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
        For Each Ar In Rng.Areas
            For Each Rw In Ar.Rows
                .Item(.Count) = Rw
            Next Rw
        Next Ar
         
        ListBox1.list = Application.Index(.Items, 0, 0)
         
    End With
    
End Sub

 

[Fluff]

Better yet try

Private Sub UserForm_Initialize()

    Dim Cl As Range

        With CreateObject("scripting.dictionary")

        For Each Cl In Sheets("Details").Range("D2", Sheets("Details").Range("D" & Rows.Count).End(xlUp))
            If Cl.Value < DateAdd("yyyy", -2, Date) Then
                .Item(.Count) = Cl.Offset(, -3).Resize(, 3).Value
            End If
        Next Cl

        ListBox1.list = Application.Index(.Items, 0, 0)

    End With

End Sub

 

[KyleJackMorrison]

Better yet try

Private Sub UserForm_Initialize()    Dim Cl As Range        With CreateObject("scripting.dictionary")        For Each Cl In Sheets("Details").Range("D2", Sheets("Details").Range("D" & Rows.Count).End(xlUp))            If Cl.Value < DateAdd("yyyy", -2, Date) Then                .Item(.Count) = Cl.Offset(, -3).Resize(, 3).Value            End If        Next Cl        ListBox1.list = Application.Index(.Items, 0, 0)    End WithEnd Sub

[/QUOTE @FluffThank you for your fast reply, you're helping me understand what to do. However, this doesn't quite work. As both "Miss Mary" and "Mr Smith" are expire. the listbox only shows:"MissMr"However if i change the date of Mr Smith to a date that hasn't expired. the userform then shows:"MissMary11223344"How would this be fixed to show both names on the list box?E.g.Miss-------Mary------11223344-----10/10/2014Mr---------Smith-----99887766-----11/10/2014Many thanks in advance!KJM

 

[Fluff]

What is the name of your sheet?
And where is the data?

 

[KyleJackMorrison]

Fluff,

Apologises for that post. It’s deleted all return spaces and won’t let me edit it.

Ive named my sheet “Details” just like your code. (I’ll change it later on)

Column A is “Title”
Column B is “Name”
Column C is “ID Number”
Column D is “Course 1 Date”

Would you like me to attach an example sheet to next post?

Many Thanks,

KJM

 

[Fluff]

Would you be willing to share your workbook via OneDrive or dropbox?
It may be that one of the listbox settings is causing problems.