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
Saturday, October 06, 2007
Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.
I was working on a solution for a client and couldn't figure it out and this code worked great! Thanks!!
ReplyDeleteThis is great I got the code working for my data set but I was wondering if you could elaborate a little on the Temp Array Variable.
ReplyDeleteI don't really understand how to utilize it.
I realize this code has been left in a very non specific format so that it can be modified for a variety of uses and I hope to learn how. Once again thank you for this excellent resource.
Ho,
Delete- Temp Array arMatches() / arTemp() variable stores the outcome of the finds.
- Say your search Range is "A1:A5" and if a match is found only in "A1", "A2" a& "A4" and no matches in "A3" & "A5".
- Note: arMatches() - from the called function - Parameter / arTemp() - from the calling function - reference passed to the parameter.
- The Temp Array variable will then have this: arMatches(1)/arTemp(1) = "A1", arMatches(2)/arTemp(2) = "A2", arMatches(3)/arTemp(3) = "A4"
Look at how these values are used: Consider this formular in example 2 -> ActiveSheet.Range(arTemp(i1)).Offset(0, 1).Value = "X".
-> Say i1 is equal to 2, on 2nd iteration - depending on base index option.
=> The formula results in ActiveSheet.Range(arTemp(2)).Offset(0, 1).Value = "X".
=> ActiveSheet.Range("A2").Offset(0, 1).Value = "X".
The above will go to Cell "A2" offset 1, Cell "B2" and change its value to "X"
zweniryu@gmail.com
Hello,
ReplyDeleteThank you very much for the great help. I used your code and worked fine.
Prathap
Karlsruhe
Awesome! Exactly what I was looking for. Saved me time writing it! Thank you.
ReplyDeleteThis is perfect for what I needed! Thank you for the huge time saver!
ReplyDeleteFinally! I've been trying to find[pun intended] a code that loops through the Find All so I could get the Address of each cell found! Now I have to figure out how to search for a cell that contain a string within its string.
ReplyDeleteThanks so much
does not work at all
ReplyDeleteError :
91 Object Variable or with block variable not set.
Hi,
DeleteThe error likely lies in here, in the calling function: FindAll("SampleText", ActiveSheet, "C:C", arTemp())
ActiveSheet needs to be a valid sheet in a valid workbook.
Remember the examples here are to illustrate the core idea so you will need to apply your mind to the bells and whistles.
I tried to change this code to search in formulae but doesn't work. Any Idea?
ReplyDeleteYou issue is likely similar to @ SahilOnline - 4:58AM GMT(+2)
DeleteSee my reply to him.