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:

[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

 

[KyleJackMorrison]

@Fluff,

appologise for the slow reply, was taking the little one out for halloween.

Please find attached the link.

https://www.dropbox.com/s/wj57ytlo33lz7kc/Public Sheet.xlsm?dl=0

Many thanks,

KJM

 

[KyleJackMorrison]

@Fluff,

Apologise for the slow reply, was taking the little one out for trick or treat.

Here is the link to the document:

https://www.dropbox.com/s/wj57ytlo33lz7kc/Public Sheet.xlsm?dl=0

Kind regards,

KJM

 

[Fluff]

@Fluff,

appologise for the slow reply, was taking the little one out for halloween.

No problem, family always come first.


Thanks for the file, the problem was that you had the listbox columns set to 1
Give this a go

Private Sub UserForm_Initialize()

    Dim Cl As Range

    With ListBox1
        .ColumnCount = 4
        .ColumnWidths = "30;50;20;50"
    End With

    With CreateObject("scripting.dictionary")
        For Each Cl In Sheets("Unit 1").Range("D5", Sheets("Unit 1").Range("D" & Rows.Count).End(xlUp))
            If Cl.Value < DateAdd("yyyy", -2, Date) Then
                .Item(.Count) = Cl.Offset(, -3).Resize(, 4).Value
            End If
        Next Cl

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

    End With

End Sub

You may need to tweak the columnwidth settings

 

[KyleJackMorrison]

@Fluff,

Outstanding, that's perfect.
Thank you for posting and helping me out with this!
Have a good evening!

Kind regards,
KJM

 

[Fluff]

Glad to help & thanks for the feedback.

 

[Rick Rothstein]

Give this a go

Private Sub UserForm_Initialize()

    Dim Cl As Range

    With ListBox1
        .ColumnCount = 4
        .ColumnWidths = "30;50;20;50"
    End With

    With CreateObject("scripting.dictionary")
        For Each Cl In Sheets("Unit 1").Range("D5", Sheets("Unit 1").Range("D" & Rows.Count).End(xlUp))
            If Cl.Value < DateAdd("yyyy", -2, Date) Then
                .Item(.Count) = Cl.Offset(, -3).Resize(, 4).Value
            End If
        Next Cl

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

    End With

End Sub

You may need to tweak the columnwidth settings

You, the OP and future readers of this thread may find it interesting that your UserForm_Initialize event code above can be compacted by removing the scripting dictionary and For..Next loop (although I will admit the code may be a tad hard to follow )...

[table="width: 500"]
[tr]
	[td]Private Sub UserForm_Initialize()
  With ListBox1
    .ColumnCount = 4
    .ColumnWidths = "30;50;20;50"
    .List = Evaluate("{""" & Replace(Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(D5:D#< DATE(YEAR(TODAY())-2,MONTH(TODAY()),DAY(TODAY())),A5:A#&"""""",""""""&SUBSTITUTE(B5:B#,"" "",""|"")&"""""",""""""&C5:C#&"""""",""""""&TEXT(D5:D#,""mm/dd/yyyy""),"""")", "#", Cells(Rows.Count, "A").End(xlUp).Row))))), " ", """;"""), "|", " ") & """}")
  End With
End Sub[/td]
[/tr]
[/table]

 

[KyleJackMorrison]

@Fluff,

So, after yourself giving me that code it worked perfectly.
However i was foolish enough to try and put it in the true version of the sheet and then change the sheet and it's all gone wrong.

The expiry date, doesn't seem to pick up the date in the cell "E" when the data has been inputted via a userform textbox. However if you type in the date on the sheet it works. (apart from if there is only 1 date expired).

I was wondering if you could have a look at it and point me in the right direction.

https://www.dropbox.com/s/rzf1pjge1g...heet.xlsm?dl=0

Many thanks in advance.

KJM

 

[Fluff]

You need to change the code in the update form

        If CheckBox1.Value = True Then
            ActiveSheet.Cells(Intcandidate, 5) = CDate(TextBox1)
        Else
            ActiveSheet.Cells(Intcandidate, 5) = ""
        End If