Search code examples
excelvbalistboxuserform

Listbox sort/filter by date time in vba userform?


I have a userform with a listbox that displays data from a worksheet. I am wanting to get that data to display in the listbox by current date and time. So when a user enters new data he/she sees the most current lines of data. This is to help the user so they don't enter duplicate information.

I am hoping this can be accomplished programmatically because in the near future this form will be linked to a database not a worksheet.

Here is the code to populate my listbox:

    Private Sub UserForm_Initialize() 'Sets variables when the userform initializes

    Call MakeFormResizeable(Me)

    Me.tbDate.Value = Format(Now(), "mm/dd/yyyy hh:mm")

     With ListBox1
        .RowSource = "Table1!A3:T100"
        .ColumnCount = 20
        .ColumnHeads = True
    End With
   End Sub

And the code to reload my listbox when the save button is clicked by calling "RefreshListbox" :

   Private Sub RefreshListbox()
       With ListBox1
         .RowSource = "Table1!A3:T100"
         .ColumnCount = 20
         .ColumnHeads = True
      End With
   End Sub

Screen shot of my userform: UserForm Screen Shot


Solution

  • Referred to Date Array Sort and Populating listbox from array

    Public declaration of an array variable in a module Public Dtarr(1 To 8) As Date One can redim the array size in a macro to resize it to the table size.

    Following is the dates table enter image description here

    Added following procedure in a module to sort a date array.

    Sub SortAr(arr() As Date)
        Dim Temp As Date
        Dim i As Long, j As Long
    
        For j = 2 To UBound(arr)
            Temp = arr(j)
            For i = j - 1 To 1 Step -1
                If (arr(i) >= Temp) Then GoTo 10
    ' ">" sorts in descending order.
    ' "<" sorts in ascending order.
                    arr(i + 1) = arr(i)
            Next i
            i = 0
    10:         arr(i + 1) = Temp
        Next j
    End Sub
    

    Added following procedure to the userform

    Private Sub UserForm_Initialize()
    Dim Sh As Worksheet
    Set Sh = ThisWorkbook.Worksheets("Sheet2")
    
    For i = 1 To 8
    Dtarr(i) = Sh.Range("A" & i + 3).Value
    Next
    
    SortAr Dtarr
    ListBox1.List = Dtarr
    
    End Sub
    

    So, the output is the descending order sorted listbox. The user can always see the latest record time at the top.

    enter image description here

    XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

    Editing answer as per your comment below

    XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

    Following is the sample data in A1:T13.

    enter image description here

    Following is userform code. You can specify the data range (arrData) in the userform code.

    Private Sub UserForm_Initialize()
    
    Set Sh = ThisWorkbook.Worksheets("Sheet1")
    Set AllData = Sh.Range("A1").CurrentRegion
    x = AllData.Rows.Count - 1: y = AllData.Columns.Count
    Set ListData = AllData.Offset(1, 0).Resize(x, y)
    
    ReDim Dtarr(1 To x, 1 To y)
    Dtarr = ListData.Value
    
    Sort2DArr Dtarr, 2 'Second column as you need to sort on Column B
    
    With ListBox1
        .List = Dtarr
        .ColumnCount = y
        .ColumnWidths = "25;100;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25"
    End With
    End Sub
    

    Following is Module1 code to sort the Dtarr. Please note Public Dtarr() in the code

    Option Base 1
    Public Sh As Worksheet
    Public AllData As Range
    Public ListData As Range
    Public x As Long
    Public y As Long
    Public Dtarr()
    
    
    
    Sub Sort2DArr(arr(), srtCol As Long)
    
    Dim temp As Date, temparr, srtColArr, temp2 As String
    Dim i As Long, j As Long
    
    ReDim temparr(x)
    srtColArr = WorksheetFunction.Index(arr, 0, srtCol)
    For i = 1 To x
        temparr(i) = Join(Application.Index(arr, i, 0), "~")
    Next
    
    temparr = Application.Transpose(temparr)
    
    For j = 2 To x
        temp = srtColArr(j, 1)
        temp2 = temparr(j, 1)
        For i = j - 1 To 1 Step -1
            If (srtColArr(i, 1) >= temp) Then GoTo 10
            ' ">" sorts in descending order.
            ' "<" sorts in ascending order.
            srtColArr(i + 1, 1) = srtColArr(i, 1)
            temparr(i + 1, 1) = temparr(i, 1)
        Next i
            i = 0
    10:     srtColArr(i + 1, 1) = temp
            temparr(i + 1, 1) = temp2
        Next j
    
    ReDim Dtarr(1 To x + 1, 1 To y)
    
    For i = 1 To y
        Dtarr(1, i) = AllData(1, i).Value
    Next
    For i = 2 To x + 1
        tempRow = Split(temparr(i - 1, 1), "~")
        For j = 1 To y
        Dtarr(i, j) = tempRow(j - 1)
        Next
    Next
    End Sub
    

    So, the output is the descending order sorted listbox. The user can always see the latest record time at the top.

    enter image description here