CODEWITHSUNDEEP
excelvba
Ilio
Ilio

Reputation: 3

Extract sequential and unique list of Years from Date Using VBA in Excel

I have a sheet where I insert dates starting from cell A2. The column contains thousands of records with different years from 2009 (2009,2011,2014 etc.). In the same year I can also find hundreds of records and the list is really annoying to scroll record by record to get to the next year. I would like to extract, through VBA, the list of ALL individual years and populate a column, for example the K column, to have the sequential and unique list of the individual years of memorization of the records.

I already tried this code:

Public Sub test1()

  Dim rSrc As Range
  Dim rDst As Range

  Set rSrc = Sheets("Sheet1").Cells(1, 1)
  Set rDst = Sheets("Sheet2").Cells(1, 1)

  rDst = rSrc
  rDst.NumberFormat = "yyyy"

End Sub

But it extract only one year from the entire column. I would like to get the list of all the years to be used in a listbox. Thanks for your help.

Upvotes: 0

Views: 903

Answers (1)

user10970498
user10970498

Reputation: 

Public Sub test1()

    dim tmp as variant, yrs as object, i as long

    set yrs = createobject("scripting.dictionary")

    with worksheets("sheet1")

        'put all years into an array to save time looping through 'thousands of records'
        tmp = .range(.cells(2, "A"), .cells(.rows.count, "A").end(xlup)).value2

        'transfer to dictionary keys as years for uniqueness
        for i = lbound(tmp, 1) to ubound(tmp, 1)
            yrs.item(year(tmp(i, 1))) = vbnullstring
        next i

        'put unique years back into column K
        .cells(2, "K").resize(yrs.count, 1) = application.transpose(yrs.keys)

        'sort unique years in column K
        with .range(.cells(2, "K"), .cells(.rows.count, "K").end(xlup))
            .sort key1:=.cells(1), order1:=xlascending, header:=xlno
        end with

    end with

end sub

Upvotes: 1

Related Questions