Excel/VBA - A Find search with multiple return

Ask a question


A simple Find search returns that will return the first coordinate.
  • In some situations it is necessary to know all the details of occurrences found.
  • This is achieved with the below function.

In a public module


'Retourne toutes les adresses trouvées dans la recherche 
'WkbN = nom du classeur, avec cette donnée la fonction peut être mise dans un xla 
'WksN = nom de la feuille 
'Plage = les coordonnées de la plage à parcourir. 
'Retour dans le tableau donner en argument. 
Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long 
Dim Cherche, Ix As Long, PrAddress 
    With Workbooks(WkbN).Sheets(WksN).Range(Plage) 
        Set Cherche = .Find(Cle) 
        If Not Cherche Is Nothing Then 
            PrAddress = Cherche.Address 
            Do 
                ReDim Preserve TBadress(Ix) 
                TBadress(Ix) = Cherche.Address 
                Set Cherche = .FindNext(Cherche) 
                Ix = Ix + 1 
            Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress 
        End If 
    End With 
    'nombre d'occurence(s) trouvée(s), Retour 0 si aucune occurence 
    RechFind = Ix 
    Set Cherche = Nothing 'Libére la mémoire occupée par l'objet. 
End Function 


Add to a Xla workbook.

Using a Macro


Sub RechMulti() 
Dim R As Long, TB() 
Dim i As Integer 
    R = RechFind("12*", ThisWorkbook.Name, "Feuil1", "B1:B500", TB()) 
    If R > 0 Then 
        For i = 0 To R - 1 ' ou ubound(TB) 
            'exemple 
            Sheets("Feuil1").Cells(i + 4, 5) = Range(TB(i)).Row 
        Next i 
    End If 
End Sub

Using a call button


Private Sub CommandButton1_Click() 
Dim R As Long, TB() 
Dim i As Integer 
    Range("E4:E20").ClearContents 
    R = RechFind(Range("E2"), ThisWorkbook.Name, ActiveSheet.Name, Range("B1:B500").Address, TB()) 
    If R > 0 Then 
        For i = 0 To R - 1 ' ou ubound(TB) 
            'exemple 
            Sheets("Feuil1").Cells(i + 4, 5) = Range(TB(i)).Row 
        Next i 
    End If 
End Sub

Download


Download the test workbook: here.
Jean-François Pillou

CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.

Learn more about the CCM team