One out of two code module in Excel VBA will have cells.Find or Findnext method. Here is a generic function - FindAll that can be used to retrieve information of all matching cells.
Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------
On Error GoTo Err_Trap
Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find
' -----------------
' Clear the Array
' -----------------
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(What:=sText, LookIn:=xlValues, LookAt:=xlPart)
If Not rFnd Is Nothing Then
rFirstAddress = rFnd.Address
Do Until rFnd Is Nothing
iArr = iArr + 1
ReDim Preserve arMatches(iArr)
arMatches(iArr) = rFnd.Address ' rFnd.Row ' Store the Row where the text is found
Set rFnd = oSht.Range(sRange).FindNext(rFnd)
If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
Loop
FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
FindAll = False
End If
' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function
The functions accepts three input parameters - Text To be searched, Worksheet, Search Range and one output Array parameter
The function searches the occurrence of that particular text in the specified range of the Excel Sheet and returns address(es) of all occurrences. The Search is by default part of Excel Cells and not whole cell
Here is a way to implement the function:
Case I : Get Addresses of all matching cells
Sub Drive_The_FindAll_Function()
' Sample Sub to Drive the Function
Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter
bFound = FindAll("SampleText", ActiveSheet, "B1:C41", arTemp())
If bFound = True Then
For i1 = 1 To UBound(arTemp)
' The Address Can be used for extracting data
MsgBox arTemp(i1)
Next i1
Else
MsgBox "Search Text Not Found"
End If
End Sub
Case II : Modify Data according to Find
In the example shown below, FindAll function is used to search 'SampleText' in column C and if the text is found a Flag 'X' is set against column D
Sub Fill_Based_on_FindAll()
' For All Matching Values in Second Column
' Add 'X' to Column D
Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter
bFound = FindAll("SampleText", ActiveSheet, "C:C", arTemp())
If bFound = True Then
For i1 = 1 To UBound(arTemp)
' The Row Number Can be used for extracting data
ActiveSheet.Range(arTemp(i1)).Offset(0, 1).Value = "X"
Next i1
Else
MsgBox "Search Text Not Found"
End If
End Sub
Case III : Get the Number of Occurrences
A simple one though; number of occurrences of the text in particular range
Sub Instances_Based_on_FindAll()
' Get the Number of Instances
Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter
bFound = FindAll("SampleText", ActiveSheet, "C:C", arTemp())
If bFound = True Then
MsgBox "No of instances : " & UBound(arTemp)
Else
MsgBox "Search Text Not Found"
End If
End Sub
Showing posts with label Excel VBA Find Matches Array. Show all posts
Showing posts with label Excel VBA Find Matches Array. Show all posts
Saturday, October 06, 2007
Subscribe to:
Posts (Atom)
Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.