Want To Show second column in List Box

[haridevadiga]

Hi All,

I am facing an issue while running this code. Below code is working fine, but when i try to show second column in listbox by putting a code which is highlighted in Yellow. It give me an error stating "Subscript Out Of Range"

Sub FindAllMatches()
'Find all matches on activesheet
'Called by: TextBox_Find_KeyUp event

Dim FindWhat As Variant
Dim FoundCells As Variant
Dim FoundCell As Range
Dim arrResults() As Variant
Dim lFound As Long
Dim lSearchCol As Long
Dim lLastRow As Long
Dim lWS As Long
Dim lCount As Long
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim lMaxRow As Long
Dim lMaxCol As Long
   
    If Len(f_FindAll.TextBox_Find.Value) > 1 Then 'Do search if text in find box is longer than 1 character.
        
        FindWhat = f_FindAll.TextBox_Find.Value
        'Calls the FindAll function
        FoundCells = FindAllOnWorksheets(Nothing, Empty, SearchAddress:=strSearchAddress, _
                                FindWhat:=FindWhat, _
                                LookIn:=xlValues, _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByColumns, _
                                MatchCase:=False, _
                                BeginsWith:=vbNullString, _
                                EndsWith:=vbNullString, _
                                BeginEndCompare:=vbTextCompare)

        'Add results of FindAll to an array
        lCount = 0
        For lWS = LBound(FoundCells) To UBound(FoundCells)
            If Not FoundCells(lWS) Is Nothing Then
                lCount = lCount + FoundCells(lWS).Count
            End If
        Next lWS
        
        If lCount = 0 Then
            ReDim arrResults(1 To 1, 1 To 2)
            arrResults(1, 1) = "No Results"
        
        Else
        
            ReDim arrResults(1 To lCount, 1 To 2)
            
            lFound = 1
            For lWS = LBound(FoundCells) To UBound(FoundCells)
                If Not FoundCells(lWS) Is Nothing Then
                    For Each FoundCell In FoundCells(lWS)
                        arrResults(lFound, 1) = FoundCell.Value
'                        arrResults(lFound, 2) = FoundCell.Offset(, 1).Value
                        arrResults(lFound, 2) = "'" & FoundCell.Parent.Name & "'!" & FoundCell.Address(External:=False)
                        lFound = lFound + 1
                    Next FoundCell
                End If
            Next lWS
        End If
        
        'Populate the listbox with the array
        Me.ListBox_Results.List = arrResults
        
    Else
        Me.ListBox_Results.Clear
    End If
        
End Sub

Private Sub ListBox_Results_Click()
'Go to selection on sheet when result is clicked

Dim strAddress As String
Dim strSheet As String
Dim strCell As String
Dim l As Long

    For l = 0 To ListBox_Results.ListCount
        If ListBox_Results.Selected(l) = True Then
            strAddress = ListBox_Results.List(l, 1)
'            strAddress = ListBox_Results.List(1, 2)
            strSheet = Replace(Mid(strAddress, 1, InStr(1, strAddress, "!") - 1), "'", "")
            Worksheets(strSheet).Select
            Worksheets(strSheet).Range(strAddress).Select
            GoTo EndLoop
        End If
    Next l

EndLoop:
    
End Sub

Can anyone help me in this

Regards,
HD