EXCEL VBA – SEARCH ALL

SEARCH ANYTHING WITH ANY WORD

Excel make our work very simple, and if you use some VBA coding, it become more reliable to your work. In excel we make reports and calculate it. You can do all things that you want to do in excel.
Today I have something special for you. Now you can find any value or name in easy way with this simple coding :
Option Explicit
Option Compare Text

Sub Show_FindAll_Form()
    f_FindAll.Show
End Sub

””””””””””””””””””””””””””””””””””””””””””
‘www.learnwells.com
””””””””””””””””””””””””””””””””””””””””””

Function FindAll(SearchRange As Range, _
                FindWhat As Variant, _
               Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
””””””””””””””””””””””””””””””””””””””””””’
‘ FindAll
””””””””””””””””””””””””””””””””””””””””””’

Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean


CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
    XLookAt = xlPart
Else
    XLookAt = LookAt
End If

‘ this loop in Areas is to find the last cell
‘ of all the areas. That is, the cell whose row
‘ and column are greater than or equal to any cell
‘ in any Area.
For Each Area In SearchRange.Areas
    With Area
        If .Cells(.Cells.Count).Row > MaxRow Then
            MaxRow = .Cells(.Cells.Count).Row
        End If
        If .Cells(.Cells.Count).Column > MaxCol Then
            MaxCol = .Cells(.Cells.Count).Column
        End If
    End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)


‘On Error Resume Next
On Error GoTo 0
Set FoundCell = SearchRange.Find(What:=FindWhat, _
        After:=LastCell, _
        LookIn:=LookIn, _
        LookAt:=XLookAt, _
        SearchOrder:=SearchOrder, _
        MatchCase:=MatchCase)

If Not FoundCell Is Nothing Then
    Set FirstFound = FoundCell
    ‘Set ResultRange = FoundCell
    ‘Set FoundCell = SearchRange.FindNext(after:=FoundCell)
    Do Until False ‘ Loop forever. We’ll “Exit Do” when necessary.
        Include = False
        If BeginsWith = vbNullString And EndsWith = vbNullString Then
            Include = True
        Else
            If BeginsWith <> vbNullString Then
                If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
            If EndsWith <> vbNullString Then
                If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
        End If
        If Include = True Then
            If ResultRange Is Nothing Then
                Set ResultRange = FoundCell
            Else
                Set ResultRange = Application.Union(ResultRange, FoundCell)
            End If
        End If
        Set FoundCell = SearchRange.FindNext(After:=FoundCell)
        If (FoundCell Is Nothing) Then
            Exit Do
        End If
        If (FoundCell.Address = FirstFound.Address) Then
            Exit Do
        End If

    Loop
End If
    
Set FindAll = ResultRange

End Function

Function FindAllOnWorksheets(InWorkbook As Workbook, _
                InWorksheets As Variant, _
                SearchAddress As String, _
                FindWhat As Variant, _
                Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Variant
””””””””””””””””””””””””””””””””””””””””””””’
‘www.learnwells.com
””””””””””””””””””””””””””””””””””””””””””””’

Dim WSArray() As String
Dim ws As Worksheet
Dim Wb As Workbook
Dim ResultRange() As Range
Dim WSNdx As Long
Dim R As Range
Dim SearchRange As Range
Dim FoundRange As Range
Dim WSS As Variant
Dim N As Long


”””””””””””””””””””””’
‘ Determine what Workbook to search.
”””””””””””””””””””””’
If InWorkbook Is Nothing Then
    Set Wb = ActiveWorkbook
Else
    Set Wb = InWorkbook
End If

”””””””””””””””””””””’
‘ Determine what sheets to search
”””””””””””””””””””””’
If IsEmpty(InWorksheets) = True Then
    ”””””””””””””””””””””
    ‘ Empty. Search all sheets.
    ”””””””””””””””””””””
    With Wb.Worksheets
        ReDim WSArray(1 To .Count)
        For WSNdx = 1 To .Count
            WSArray(WSNdx) = .item(WSNdx).Name
        Next WSNdx
    End With

Else
    ”””””””””””””””””””’
    ‘ If Object, ensure it is a Worksheet
    ‘ object.
    ”””””””””””””””””””
    If IsObject(InWorksheets) = True Then
        If TypeOf InWorksheets Is Excel.Worksheet Then
            ”””””””””””””””””””””
            ‘ Ensure Worksheet is in the WB workbook.
            ”””””””””””””””””””””
            If StrComp(InWorksheets.Parent.Name, Wb.Name, vbTextCompare) <> 0 Then
                ”””””””””””””””
                ‘ Sheet is not in WB. Get out.
                ”””””””””””””””
                Exit Function
            Else
                ”””””””””””””””
                ‘ Same workbook. Set the array
                ‘ to the worksheet name.
                ”””””””””””””””
                ReDim WSArray(1 To 1)
                WSArray(1) = InWorksheets.Name
            End If
        Else
            ””””””””””””””””””’
            ‘ Object is not a Worksheet. Get out.
            ””””””””””””””””””’
        End If
    Else
        ”””””””””””””””””””””’
        ‘ Not empty, not an object. Test for array.
        ”””””””””””””””””””””’
        If IsArray(InWorksheets) = True Then
            ”””””””””””””””””””’
            ‘ It is an array. Test if each element
            ‘ is an object. If it is a worksheet
            ‘ object, get its name. Any other object
            ‘ type, get out. Not an object, assume
            ‘ it is the name.
            ””””””””””””””””””””
            ReDim WSArray(LBound(InWorksheets) To UBound(InWorksheets))
            For WSNdx = LBound(InWorksheets) To UBound(InWorksheets)
                If IsObject(InWorksheets(WSNdx)) = True Then
                    If TypeOf InWorksheets(WSNdx) Is Excel.Worksheet Then
                        ”””””””””””””””””””
                        ‘ It is a worksheet object, get name.
                        ”””””””””””””””””””
                        WSArray(WSNdx) = InWorksheets(WSNdx).Name
                    Else
                        ””””””””””””””””
                        ‘ Other type of object, get out.
                        ””””””””””””””””
                        Exit Function
                    End If
                Else
                    ”””””””””””””””””””””’
                    ‘ Not an object. If it is an integer or
                    ‘ long, assume it is the worksheet index
                    ‘ in workbook WB.
                    ”””””””””””””””””””””’
                    Select Case UCase(TypeName(InWorksheets(WSNdx)))
                        Case “LONG”, “INTEGER”
                            Err.Clear
                            ”””””””””””””””””’
                            ‘ Ensure integer if valid index.
                            ”””””””””””””””””’
                            Set ws = Wb.Worksheets(InWorksheets(WSNdx))
                            If Err.Number <> 0 Then
                                ”””””””””””””””’
                                ‘ Invalid index.
                                ”””””””””””””””’
                                Exit Function
                            End If
                            ””””””””””””””””””
                            ‘ Valid index. Get name.
                            ””””””””””””””””””
                            WSArray(WSNdx) = Wb.Worksheets(InWorksheets(WSNdx)).Name
                        Case “STRING”
                            Err.Clear
                            ””””””””””””””””””’
                            ‘ Ensure valid name.
                            ””””””””””””””””””’
                            Set ws = Wb.Worksheets(InWorksheets(WSNdx))
                            If Err.Number <> 0 Then
                                ””””””””””””””””’
                                ‘ Invalid name, get out.
                                ””””””””””””””””’
                                Exit Function
                            End If
                            WSArray(WSNdx) = InWorksheets(WSNdx)
                    End Select
                End If
                ‘WSArray(WSNdx) = InWorksheets(WSNdx)
            Next WSNdx
        Else
            ””””””””””””””””””””””
            ‘ InWorksheets is neither an object nor an
            ‘ array. It is either the name or index of
            ‘ the worksheet.
            ””””””””””””””””””””””
            Select Case UCase(TypeName(InWorksheets))
                Case “INTEGER”, “LONG”
                    ”””””””””””””””””””’
                    ‘ It is a number. Ensure sheet exists.
                    ”””””””””””””””””””’
                    Err.Clear
                    Set ws = Wb.Worksheets(InWorksheets)
                    If Err.Number <> 0 Then
                        ”””””””””””””””’
                        ‘ Invalid index, get out.
                        ”””””””””””””””’
                        Exit Function
                    Else
                        WSArray = Array(Wb.Worksheets(InWorksheets).Name)
                    End If
                Case “STRING”
                    ”””””””””””””””””””””””””’
                    ‘ See if the string contains a ‘:’ character. If
                    ‘ so, the InWorksheets contains a string of multiple
                    ‘ worksheets.
                    ”””””””””””””””””””””””””’
                    If InStr(1, InWorksheets, “:”, vbBinaryCompare) > 0 Then
                        ”””””””””””””””””””””
                        ‘ “:” character found. split apart sheet
                        ‘ names.
                        ”””””””””””””””””””””
                        WSS = Split(InWorksheets, “:”)
                        Err.Clear
                        N = LBound(WSS)
                        If Err.Number <> 0 Then
                            ””””””””””””””’
                            ‘ Unallocated array. Get out.
                            ””””””””””””””’
                            Exit Function
                        End If
                        If LBound(WSS) > UBound(WSS) Then
                            ””””””””””””””’
                            ‘ Unallocated array. Get out.
                            ””””””””””””””’
                            Exit Function
                        End If
                            
                                                
                        ReDim WSArray(LBound(WSS) To UBound(WSS))
                        For N = LBound(WSS) To UBound(WSS)
                            Err.Clear
                            Set ws = Wb.Worksheets(WSS(N))
                            If Err.Number <> 0 Then
                                Exit Function
                            End If
                            WSArray(N) = WSS(N)
                         Next N
                    Else
                        Err.Clear
                        Set ws = Wb.Worksheets(InWorksheets)
                        If Err.Number <> 0 Then
                            ””””””””””””””””’
                            ‘ Invalid name, get out.
                            ””””””””””””””””’
                            Exit Function
                        Else
                            WSArray = Array(InWorksheets)
                        End If
                    End If
            End Select
        End If
    End If
End If
”””””””””””””””””””””’
‘ Ensure SearchAddress is valid
”””””””””””””””””””””’
On Error Resume Next
For WSNdx = LBound(WSArray) To UBound(WSArray)
    Err.Clear
    Set ws = Wb.Worksheets(WSArray(WSNdx))
    ””””””””””””””””””””
    ‘ Worksheet does not exist
    ””””””””””””””””””””
    If Err.Number <> 0 Then
        Exit Function
    End If
    Err.Clear
    Set R = Wb.Worksheets(WSArray(WSNdx)).Range(SearchAddress)
    If Err.Number <> 0 Then
        ””””””””””””””””””
        ‘ Invalid Range. Get out.
        ””””””””””””””””””
        Exit Function
    End If
Next WSNdx

””””””””””””””””””””
‘ SearchAddress is valid for all sheets.
‘ Call FindAll to search the range on
‘ each sheet.
””””””””””””””””””””
ReDim ResultRange(LBound(WSArray) To UBound(WSArray))
For WSNdx = LBound(WSArray) To UBound(WSArray)
    Set ws = Wb.Worksheets(WSArray(WSNdx))
    Set SearchRange = ws.Range(SearchAddress)
    Set FoundRange = FindAll(SearchRange:=SearchRange, _
                    FindWhat:=FindWhat, _
                    LookIn:=LookIn, LookAt:=LookAt, _
                    SearchOrder:=SearchOrder, _
                    MatchCase:=MatchCase, _
                    BeginsWith:=BeginsWith, _
                    EndsWith:=EndsWith)
    
    If FoundRange Is Nothing Then
        Set ResultRange(WSNdx) = Nothing
    Else
        Set ResultRange(WSNdx) = FoundRange
    End If
Next WSNdx

FindAllOnWorksheets = ResultRange

End Function

Just copy the above code and paste it to your excel sheet. 
Open your excel sheet
Press Alt+F11
Create a module and paste the code on it.
For more detail please watch the above video.
Also you can download this sheet with below download link : 

Leave a Comment