Date format in VBA

Stephen Byrom
Stephen Byrom used Ask the Experts™
on
HI,
I have this code that I copied from Microsoft's help pages to populate an activeX combo box on a worksheet.
Private Sub Worksheet_Activate()
    Dim wbBook As Workbook
    Dim WS As Worksheet
    Dim WS2 As Worksheet
    Dim rnData As Range

    'Variant to contain the data to be placed in the combo box.
    Dim vaData As Variant

    'Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set WS = wbBook.Worksheets("ShiptToy")
    Set WS2 = wbBook.Worksheets("Toyota")

    'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
    With WS
        Set rnData = .Range(.Range("F2"), .Range("F1000").End(xlUp))
        rnData.AdvancedFilter Action:=xlFilterCopy, _
                          CopyToRange:=.Range("AA1"), _
                          Unique:=True
        'store the unique values in vaData
        vaData = .Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value
        'clean up the contents of the temporary data storage
        .Range(.Range("AA1"), .Range("AA1000").End(xlUp)).ClearContents
    End With

    'display the unique values in vaData in the combo box already in existence on the worksheet.
    With WS2.OLEObjects("ComboBox1").Object
        .Clear
        .List = vaData
        .ListIndex = -1
    End With
End Sub

Open in new window

Problem is that the column I'm filling the combo box with is full of dates, and although the code does the job, it's in the american format (m/d/y)
How can I get the combo box to show dates as  dd/mmm.

Thanks in advance
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2008

Commented:
Insert before this line:

        vaData = .Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value

this line:

        .Range(.Range("AA2"), .Range("AA1000").End(xlUp)).NumberFormat = "dd/mmm"

Kevin
Top Expert 2008

Commented:
Actually, I don't think that will work. The value copied into the array is an unformatted date.

Kevin
Top Expert 2008

Commented:
Try this:

Private Sub Worksheet_Activate()
    Dim wbBook As Workbook
    Dim WS As Worksheet
    Dim WS2 As Worksheet
    Dim rnData As Range
    Dim Index As Long

    'Variant to contain the data to be placed in the combo box.
    Dim vaData As Variant
    Dim vaDataFormatted As Variant

    'Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set WS = wbBook.Worksheets("ShiptToy")
    Set WS2 = wbBook.Worksheets("Toyota")

    'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
    With WS
        Set rnData = .Range(.Range("F2"), .Range("F1000").End(xlUp))
        rnData.AdvancedFilter Action:=xlFilterCopy, _
                          CopyToRange:=.Range("AA1"), _
                          Unique:=True
        'store the unique values in vaData
        vaData = .Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value
        ReDim vaDataFormatted(LBound(vaData) To UBound(vaData))
        For Index = LBound(vaDataFormatted) To UBound(vaDataFormatted)
            vaDataFormatted(Index) = Format(vaData(Index), "dd/mmm")
        Next Index
        'clean up the contents of the temporary data storage
        .Range(.Range("AA1"), .Range("AA1000").End(xlUp)).ClearContents
    End With

    'display the unique values in vaData in the combo box already in existence on the worksheet.
    With WS2.OLEObjects("ComboBox1").Object
        .Clear
        .List = vaDataFormatted
        .ListIndex = -1
    End With
End Sub

Kevin
Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Stephen ByromWarehouse/Shipping

Author

Commented:
You're right, didn't work.
But thanks for trying.
I also tried to sort the column xldescending but couldn't get that to work either.
Stephen ByromWarehouse/Shipping

Author

Commented:
Oops posts musta crossed.
Anyway, thanks again for your time, but I get an error at this line

            vaDataFormatted(Index) = Format(vaData(Index), "dd/mmm")
Top Expert 2008

Commented:
Change this line:

       vaData = .Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value

to:

       vaData = Application.Transpose(.Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value)

Kevin
Stephen ByromWarehouse/Shipping

Author

Commented:
I managed to get this to work Kevin,
    Dim wbBook As Workbook
    Dim WS As Worksheet
    Dim WS2 As Worksheet
    Dim rnData As Range
    Dim Index As Long

    'Variant to contain the data to be placed in the combo box.
    Dim vaData As Variant
    Dim vaDataFormatted As Variant

    'Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set WS = wbBook.Worksheets("ShiptToy")
    Set WS2 = wbBook.Worksheets("Toyota")

    'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
    With WS
        Set rnData = .Range(.Range("F2"), .Range("F1000").End(xlUp))
        rnData.AdvancedFilter Action:=xlFilterCopy, _
                          CopyToRange:=.Range("AA1"), _
                          Unique:=True
        'store the unique values in vaData
        vaData = .Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value
        ReDim vaDataFormatted(LBound(vaData) To UBound(vaData))
        For Index = LBound(vaDataFormatted) To UBound(vaDataFormatted)
            vaDataFormatted(Index) = Format(rnData(Index), "dd/mmm")
        Next Index
        'clean up the contents of the temporary data storage
        .Range(.Range("AA1"), .Range("AA1000").End(xlUp)).ClearContents
    End With

    'display the unique values in vaData in the combo box already in existence on the worksheet.
    With WS2.OLEObjects("ComboBox1").Object
        .Clear
        .List = vaDataFormatted
        .ListIndex = -1
    End With
End Sub

Open in new window

I changed the "vaData" to "rnData" (line 26)
Is there a way to sort the data descending before it fills the combo box?
Stephen ByromWarehouse/Shipping

Author

Commented:
Nope, I was wrong.
not filling the combo box with all the data.
I'll trim down the workbook and upload it to give you a better idea of what I'm trying to do.
Top Expert 2008
Commented:
That will produce odd results. Use this code:

Private Sub Worksheet_Activate()
    Dim wbBook As Workbook
    Dim WS As Worksheet
    Dim WS2 As Worksheet
    Dim rnData As Range
    Dim rnDataUnique As Range
    Dim Index As Long

    'Variant to contain the data to be placed in the combo box.
    Dim vaData As Variant
    Dim vaDataFormatted As Variant

    'Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set WS = wbBook.Worksheets("ShiptToy")
    Set WS2 = wbBook.Worksheets("Toyota")

    'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
    With WS
        Set rnData = .Range(.Range("F2"), .Range("F1000").End(xlUp))
        rnData.AdvancedFilter Action:=xlFilterCopy, _
                          CopyToRange:=.Range("AA1"), _
                          Unique:=True
        Set rnDataUnique = .Range(.Range("AA1"), .Range("AA1000").End(xlUp))
        rnDataUnique.Sort Key1:=rnDataUnique.Columns(1), Order1:=xlDescending
        'store the unique values in vaData
        vaData = Application.Transpose(.Range(.Range("AA2"), .Range("AA1000").End(xlUp)).Value)
        ReDim vaDataFormatted(LBound(vaData) To UBound(vaData))
        For Index = LBound(vaDataFormatted) To UBound(vaDataFormatted)
            vaDataFormatted(Index) = Format(vaData(Index), "dd/mmm")
        Next Index
        'clean up the contents of the temporary data storage
        .Range(.Range("AA1"), .Range("AA1000").End(xlUp)).ClearContents
    End With

    'display the unique values in vaData in the combo box already in existence on the worksheet.
    With WS2.OLEObjects("ComboBox1").Object
        .Clear
        .List = vaDataFormatted
        .ListIndex = -1
    End With
End Sub

Kevin
Stephen ByromWarehouse/Shipping

Author

Commented:
here goes,
combo.xlsm
Stephen ByromWarehouse/Shipping

Author

Commented:
Brilliant!
Thanks for your time and expertise.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial