'-----------------------------------------------------------------
 '/// This MUST go at module level in the UserForm (i.e., be the first thing in the code):
 '-----------------------------------------------------------------
Option Explicit 
 
Dim listSelect() As Integer, totalSelect As Integer, eventsEnabler As Integer 
 
 '-----------------------------------------------------------------
 '/// Wherever you set up the ListBox with its contents, include the following code.
 '/// This is often, but not always, UserForm_Initialize()
 '/// In this example, our ListBox is called ListBox1. Change references as appropriate
 '-----------------------------------------------------------------
 ' Disable ListBox1_Change() code
eventsEnabler = 1 
 
With ListBox1 
     
     ' .AddItems here
     
End With 
 
ReDim listSelect(0 To ListBox1.ListCount - 1) 
totalSelect = 0 
 
 ' Enable _Change() code
eventsEnabler = eventsEnabler - 1 
 
 '-----------------------------------------------------------------
 '/// This is the key section that needs to be in the UserForm code:
 '-----------------------------------------------------------------
Private Sub ListBox1_Change() 
    Dim i As Integer, j As Integer, indexStart As Integer, indexEnd As Integer 
     
     ' When setting up ListBox1, set eventsEnabler to > 0 to prevent this code from executing!
    If eventsEnabler = 0 Then 
         
         ' Start by assuming we'll search for new selections top-to-bottom
        indexStart = 0 
        indexEnd = ListBox1.ListCount - 1 
         
         '       This block determines direction of additional selections (up or down)
        For i = 0 To ListBox1.ListCount - 1 
             ' If we've hit the previous last selection, we already know the answer (top-to-bottom)
            If listSelect(i) = totalSelect Then Exit For 
             ' If we hit a new selection before finding the previous last selection,
             ' then we'll change the search for new selections to be bottom-to-top
            If listSelect(i) = 0 And ListBox1.Selected(i) Then 
                indexStart = indexEnd 
                indexEnd = 0 
                Exit For 
            End If 
        Next i 
         
        stepDir = Sgn(indexEnd - indexStart) 
        If stepDir = 0 Then stepDir = 1 
         
         '       Update selection list in listSelect()
        For i = indexStart To indexEnd Step stepDir 
            If ListBox1.Selected(i) = True Then 
                 '               Newly selected item: place selection number in listSelect() and update totalSelect
                If listSelect(i) = 0 Then 
                    listSelect(i) = totalSelect + 1 
                    totalSelect = totalSelect + 1 
                End If 
            Else 
                 '               Deselected item: remove its selection number, and update all others to compensate.
                If listSelect(i) > 0 Then 
                    For j = 0 To ListBox1.ListCount - 1 
                        If listSelect(j) > listSelect(i) Then listSelect(j) = listSelect(j) - 1 
                    Next j 
                    listSelect(i) = 0 
                    totalSelect = totalSelect - 1 
                End If 
            End If 
        Next i 
         
         ' At this point, totalSelect and listSelect() are updated for you to act upon.
         ' The example file includes a call to update the ListBox contents based on these values.
    End If 
End Sub