Programatic ListBox selection is selecting the wrong item - vba

Question

I am building an Excel VBA project which makes use of a ListBox to navigate through a tree structure. By double clicking an item it will expand below with additional items. My goal is that by making this selection the change will be made and the ListBox will update, whilst retaining the selection just clicked by the user and keeping it in view.
I have created a separate workbook to isolate the problem I have to make it simpler, and I will be able to replicate any solutions into my original project.
My ListBox is populated using RowSource. Values are stored on a sheet (for genuine reasons I'll omit from this post to keep it to the point), changes are made to the sheet and then RowSource is called again to update the ListBox. By doing this the ListBox will update and then jump down to where the selection made is the last item in the view, but the list item now selected is the one in the position of the previous selection which is incorrect.
Example:
User scrolls down the ListBox using the scrollbar and double clicks item 'Test 100'
ListBox is updated, however the selection is incorrect. 'Test 86' is selected which is in the position of the previous selection 'Test 100', which is placed at the bottom of the view.
Here's a download link for the example workbook
I'm hoping someone will be able to shine some light on an elegant solution to correct this behaviour!
I have tried programmatically making the selection after the RowSource update, however this has no effect. By adding a brief pause and calling DoEvents (commented in the example) I've been able to make this work to some extent, however I have found that it doesn't work all the time and I would prefer not to have to force a pause as this as it makes the ListBox feel less responsive in my original project.
Private selection As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selection = ListBox1.ListIndex
Call update
End Sub
Private Sub UserForm_Initialize()
Call update
End Sub
Sub update()
With Sheets("Test")
ListBox1.RowSource = .Range("A2:A" & .Range("A99999").End(xlUp).Row - 1).Address(, , , True)
End With
'Sleep 300
'DoEvents
ListBox1.ListIndex = selection
End Sub

Answer 1

Because it is a timing issue, I think either delays or timers will be required for a solution. This isn't a terribly elegant workaround, but seems to work in my limited tests:
UF module:
Option Explicit
Private selection As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selection = ListBox1.ListIndex
Call update
End Sub
Private Sub UserForm_Initialize()
Call update
End Sub
Sub update()
Dim hwndUF As Long
With Sheets("Test")
ListBox1.RowSource = .Range("A2:A" & .Range("A99999").End(xlUp).Row - 1).Address(, , , True)
End With
If selection <> 0 Then
hwndUF = FindWindow("ThunderDFrame", Me.Caption)
UpdateListIndex hwndUF
End If
End Sub
Public Sub UpdateLBSelection()
ListBox1.ListIndex = selection
End Sub
and then in a normal module:
Option Explicit
Private Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private hWndTimer As Long
Sub UpdateListIndex(hWnd As Long)
Dim lRet As Long
hWndTimer = hWnd
LockWindowUpdate hWndTimer
lRet = SetTimer(hWndTimer, 0, 100, AddressOf TimerProc)
End Sub
Public Function TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal dwTime As Long) As Long
On Error Resume Next
KillTimer hWndTimer, idEvent
UserForm1.UpdateLBSelection
LockWindowUpdate 0&
Userform1.Repaint
End Function

Answer 2

use
Private selection As Variant '<~~ use a Variant to store the ListBox current Value
'...
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
selection = ListBox1.Value '<~~ store the ListBox current Value
Call update '<~~ this will change the ListBox "RowSource"
ListBox1.Value = selection '<~~ get back the stored ListBox value selected before 'update' call
End Sub

Answer 3

I know that this is ancient now, but I had the same problem a couple of months ago and just stumbled on the solution (to my problem) of not selecting the right item in a listbox.
It turned out to be that the zoom level of the sheet was causing an accuracy issue. Listboxes sometimes look slightly fuzzy when at certain zoom levels - maybe thats just me - anyway, the solution was just to zoom in/out a point that didnt cause the problem.
Thanks
R

Answer 4

I also ran into this problem and a simple adding of Userform.Repaint before the setting the ListBox selection did the trick ......