列表框显示不在范围内的日期

Question

I'm having trouble with my Listbox . When I run the following code for the first time, it always runs showing only 1 date which is 30/12/1899 . The range that I've specified only contains 6 dates which are 8/1/2014, 9/1/2014, 14/1/2014, 24/1/2014, 24/1/2014 and 02/02/2014 . Once I stop the form and run it again, all the required dates show up.

I've just started learning VBA on Excel so I'm still struggling to understand the concepts. Is there something that I'm missing? The reason for no duplicates is that I can't show the 2 dates (24/01/2014).

Private Sub UserForm_Activate()

    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    Dim wksJobDetail As Worksheet

'The items are in A2:A7
    Set AllCells = Range("A2:A7")

'Point the variable to JobSchedule worksheet
    Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule")
    wksJobDetail.Activate

'Statement ignores any errors regarding duplicates and duplicate dates aren't added
    On Error Resume Next
    For Each Cell In AllCells
        NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
            CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
    Next Cell

'Add non-duplicated items into lstDate
    For Each Item In NoDupes
        JobDetail.lstDate.AddItem Item
    Next Item
End Sub

Answer 1

Set AllCells = Range("A2:A7") will reference the active worksheet which may or may not be wksJobDetail .

The second time you run it wksJobDetail has been activated.

Try putting the Set AllCells = Range("A2:A7") statement after:

Set wksJobDetail = Application.Workbooks("xxxxx.xlsm").Worksheets("JobSchedule") wksJobDetail.Activate

Answer 2

I think it has something to do with how you format your data in Excel and the proper way of referencing source range.

Try this: First, check if the dates are correctly entered as dates in Excel like below.

Then make this line explicit:

Set AllCells = Range("A2:A7")

and change to this:

Set AllCells = Sheets("JobSchedule").Range("A2:A7") 

Now, run your code which I've rewritten below adding On Error Goto 0 .

Dim AllCells As Range, Cell As Range, Item
Dim NoDupes As New Collection

Set AllCells = Sheets("JobSchedule").Range("A2:A7")

On Error Resume Next '~~> Ignore Error starting here
For Each Cell In AllCells
    NoDupes.Add Format(CDate(Cell.Value), "dd/mm/yyyy"), _
        CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
Next Cell
On Error GoTo 0 '~~> Stops ignoring error

For Each Item In NoDupes
    JobDetail.lstDate.AddItem Item
Next Item

And that should give you the result you want. Also, I suggest to use Initialize Event instead of Activate .
Everytime you use OERN , do not forget to use OEG0 to reset the error handling.
Otherwise, you will not be able to trap other errors not related to the adding existing item in Collection .

Bonus:

Another way to do this is to use a Dictionary instead. You need to add reference to Microsoft Scripting Runtime . I rewrote part of your code which will have the same effect. The advantage of a Dictionary is that it offers other helpful properties that you can use.

Private Sub UserForm_Initialize()
    Dim AllCells As Range, Cell As Range
    Dim d As Dictionary

    Set AllCells = Sheets("Sheet1").Range("A2:A7")
    Set d = New Dictionary

    For Each Cell In AllCells
        d.Item(Format(CDate(Cell.Value), "dd/mm/yyyy")) = _
            CStr(Format(CDate(Cell.Value), "dd/mm/yyyy"))
    Next Cell
    JobDetail.lstDate.List = d.Keys
End Sub

As you can see, we removed one Loop by using Keys property which is an array of all unique keys.
I hope this somehow helps.