CODEWITHSUNDEEP
excelvba
Jason Kelly
Jason Kelly

Reputation: 2645

Function to find all matches of a value

I need your help.

Sorry, I am really new to VBA but, how do I go about converting or adding onto the Excel function below to loop through all the found matches. Right now it only returns 1 match but i'd like to to have it modified to return all occurrences of a match so that I can input it into my userform for processing later.

Private Sub Search_Click()

    With Sheet1
        Set foundCell = .Cells.find(What:="test", After:=.Cells(1, 1), _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    End With

If Not foundCell Is Nothing Then
        MsgBox ("""Match"" found in row " & foundCell.Row)
        form1.location.Value = Cells(foundCell.Row, 1).Value
Else
        MsgBox ("No match not found")
End If

End Sub

Upvotes: 0

Views: 4428

Answers (2)

Guest
Guest

Reputation: 430

Just in case you need to store data for all cells that contained your search item, you could use the following. Usage: myArray = makeArrayFoundCellInfoInRange("test", Sheets.("Sheet1").Range("A1:Z500"))

'**************************************************************************************************************************************************************
'To return an array of information (value, formula, address, row, and column) for all the cells from a specified Range that have the searched item as value
'Returns an empty array if there is an error or no data
'**************************************************************************************************************************************************************
Public Function makeArrayFoundCellInfoInRange(ByVal itemSearched As Variant, ByVal aRange As Variant) As Variant
Dim cell As Range, tmpArr As Variant, x As Long

tmpArr = Array()
If TypeName(aRange) = "Range" Then
    x = 0
    For Each cell In aRange
        If itemSearched = cell.Value Then
            If x = 0 Then
                ReDim tmpArr(0 To 0, 0 To 4)
            Else
                tmpArr = reDimPreserve(tmpArr, UBound(tmpArr, 1) + 1, UBound(tmpArr, 2))
            End If
            tmpArr(x, 0) = cell.Value
            tmpArr(x, 1) = cell.Formula
            tmpArr(x, 2) = cell.Address(0, 0) 'Without the dollar signs
            tmpArr(x, 3) = cell.Row
            tmpArr(x, 4) = cell.Column
            x = x + 1
        End If
    Next cell
End If
makeArrayFoundCellInfoInRange = tmpArr
Erase tmpArr

End Function

Upvotes: 0

Kubie
Kubie

Reputation: 1571

You can try findnext or add some small edits like something along these lines, just a continuous loop until you run out of matches

Private Sub Search_Click()

    Dim rowNum As Long: rowNum = 1
    Dim colNum As Long: colNum = 1

    Do While ( True )

        With Sheet1
            Set foundCell = .Cells.find(What:="test", After:=.Cells(rowNum, colNum), _
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        End With

        If Not foundCell Is Nothing Then
            MsgBox ("""Match"" found in row " & foundCell.Row)
            form1.location.Value = form1.location.Value & vbCrLf & Cells(foundCell.Row, 1).Value
            if foundCell.Row < rowNum Then Exit Do
            rowNum = foundCell.Row
            colNum = foundCell.Column
        Else
            If rowNum = 1 Then MsgBox ("No matches found")
            Exit Do
        End If

    Loop

End Sub

Upvotes: 2

Related Questions