Solved

Date format in VBA

Posted on 2014-03-05
11
401 Views
Last Modified: 2014-03-05
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
0
Comment
Question by:Stephen Byrom
  • 6
  • 5
11 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 39907827
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
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 39907842
Actually, I don't think that will work. The value copied into the array is an unformatted date.

Kevin
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 39907860
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
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 39907864
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.
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 39907883
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")
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 39907887
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
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 39907907
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?
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 39907929
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.
0
 
LVL 81

Accepted Solution

by:
zorvek (Kevin Jones) earned 500 total points
ID: 39907933
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
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 39907945
here goes,
combo.xlsm
0
 
LVL 1

Author Closing Comment

by:Stephen Byrom
ID: 39907954
Brilliant!
Thanks for your time and expertise.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now