Private Function GetSecondMax() As Integer
    GetSecondMax = List1.List(List1.ListCount -  2 )
End Function

Option Explicit

Private mrsListData As ADODB.Recordset

Public Sub MakeDataList(ByVal pintNbrOfItems As Integer)
    Dim intListIndex As Integer
    Dim intListItem As Integer
    
    Set mrsListData = New ADODB.Recordset
    
    With List1
        .Clear
         .Height =  4400 
    End With
    
    Randomize
    
    With mrsListData
    
        With .Fields
            .Append "ListIndex", adSmallInt
            .Append "Item", adSmallInt
        End With
        
        .Open
        
        For intListIndex =  0  To pintNbrOfItems
            intListItem = Int(( 10000  * Rnd) +  1 )
            List1.AddItem CStr(intListItem), intListIndex
            .AddNew Array("ListIndex", "Item"), Array(intListIndex, CStr(intListItem))
        Next intListIndex
    
    End With
    
End Sub

Private Sub Form_Load()
    MakeDataList  30 
End Sub

Private Sub Command1_Click()
    List1.ListIndex = HighlightSecondMaximum
End Sub

Public Function HighlightSecondMaximum() As Integer
    
    With mrsListData
        .Sort = "Item desc"
        
        If .RecordCount >  1  Then
            .MoveNext
        End If
        
        HighlightSecondMaximum = .Collect( 0 )
        
    End With
    
End Function