CODEWITHSUNDEEP
vbaexcelexcel-2010userform
Carrosive
Carrosive

Reputation: 899

Programatic ListBox selection is selecting the wrong item

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:

  1. User scrolls down the ListBox using the scrollbar and double clicks item 'Test 100'
  2. 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. Image Here

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

Upvotes: 1

Views: 1714

Answers (4)

Dschuli
Dschuli

Reputation: 379

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

Upvotes: 0

Richard Dougan
Richard Dougan

Reputation: 1

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

Upvotes: 0

Rory
Rory

Reputation: 34075

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

Upvotes: 1

user3598756
user3598756

Reputation: 29421

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

Upvotes: 0

Related Questions