sparkytech
Board Regular
- Joined
- Mar 6, 2018
- Messages
- 96
- Office Version
- 365
- 2019
I have a userform that displays a listbox with values from column "B", and everything works as it should. I would like this to scroll to the top of the list every time it the listbox is displayed. How can I do this?
VBA Code:
Private Sub UserForm_Initialize()
Dim rng As Range
Dim cell As Range
Dim ws As Worksheet
Dim arr() As Variant
Dim i As Long
Set ws = ThisWorkbook.Sheets("Projects") ' Change to your sheet name
Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
i = 0
For Each cell In rng
If Left(cell.Value, 1) = "*" And InStr(cell.Offset(0, 1).Value, "?") = 0 Then
ReDim Preserve arr(i)
arr(i) = cell.Offset(0, 1).Value
i = i + 1
End If
Next cell
' Sort the array
Call BubbleSort(arr)
' Add items to ListBox
For i = LBound(arr) To UBound(arr)
ListBox1.AddItem arr(i)
Next i
End Sub
Private Sub ListBox1_Click()
Dim rng As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Projects")
Set rng = ws.Range("B1:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row).Find(ListBox1.Value)
If Not rng Is Nothing Then
rng.Select
ActiveWindow.ScrollRow = rng.Row ' This will scroll the selected cell to the top
End If
Me.Hide ' This will hide the UserForm after a click
End Sub
Sub BubbleSort(arr() As Variant)
Dim i As Long, j As Long
Dim Temp As Variant
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If Right(arr(i), 1) = "<" And Right(arr(j), 1) <> "<" Then
Temp = arr(i)
arr(i) = arr(j)
arr(j) = Temp
ElseIf Right(arr(i), 1) <> "<" And Right(arr(j), 1) <> "<" And arr(i) > arr(j) Then
Temp = arr(i)
arr(i) = arr(j)
arr(j) = Temp
End If
Next j
Next i
End Sub