Listbox sort/filter by date time in vba userform?

久未见 提交于 2021-01-28 19:14:10

问题


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


回答1:


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

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.

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Editing answer as per your comment below

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Following is the sample data in A1:T13.

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.



来源:https://stackoverflow.com/questions/61530566/listbox-sort-filter-by-date-time-in-vba-userform

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!