Populate ListBox1 with rows that have expired dates in.

KyleJackMorrison

Board Regular
Joined
Dec 3, 2013
Messages
107
Office Version
  1. 365
  2. 2021
  3. 2019
Platform
  1. Windows
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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Title[/TD]
[TD]Name[/TD]
[TD]ID No.[/TD]
[TD]Course 1[/TD]
[/TR]
[TR]
[TD]Mr[/TD]
[TD]Joe[/TD]
[TD]22334455[/TD]
[TD]01/01/2017[/TD]
[/TR]
[TR]
[TD]Miss[/TD]
[TD]Mary[/TD]
[TD]11223344[/TD]
[TD]10/10/2014[/TD]
[/TR]
[TR]
[TD]Mr[/TD]
[TD]Smith[/TD]
[TD]99887766[/TD]
[TD]01/01/2012[/TD]
[/TR]
</tbody>[/TABLE]

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
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
How about
Code:
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
 
Upvote 0
How about
Code:
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)
 
Last edited:
Upvote 0
Try this instead
Code:
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
 
Last edited:
Upvote 0
Better yet try
Code:
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
 
Upvote 0
Better yet try
Code:
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
 
Upvote 0
What is the name of your sheet?
And where is the data?
 
Upvote 0
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
 
Upvote 0
Would you be willing to share your workbook via OneDrive or dropbox?
It may be that one of the listbox settings is causing problems.
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top