|
Discussion:
|
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
|
Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
On Error GoTo Err_Trap
Dim rFnd As Range
Dim iArr As Integer
Dim rFirstAddress
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
Set rFnd = oSht.Range(sRange).FindNext(rFnd)
If rFnd.Address = rFirstAddress Then Exit Do
Loop
FindAll = True
Else
FindAll = False
End If
Err_Trap:
If Err <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function
|