How to find and change every match in excel find from VBA not just the next one? [duplicate] - excel

I am trying to write a VBA routine that will take a string, search a given Excel workbook, and return to me all possible matches.
I currently have an implementation that works, but it is extremely slow as it is a double for loop. Of course the built in Excel Find function is "optimized" to find a single match, but I would like it to return an array of initial matches that I can then apply further methods to.
I will post some pseudocode of what I have already
For all sheets in workbook
For all used rows in worksheet
If cell matches search string
do some stuff
end
end
end
As previously stated, this double for loop makes things run very slowly, so I am looking to get rid of this if possible. Any suggestions?
UPDATE
While the below answers would have improved my method, I ended up going with something slightly different as I needed to do multiple queries over and over.
I instead decided to loop through all rows in my document and create a dictionary containing a key for each unique row. The value this points to will then be a list of possible matches, so that when I query later, I can simply just check if it exists, and if so, just get a quick list of matches.
Basically just doing one initial sweep to store everything in a manageable structure, and then query that structure which can be done in O(1) time

Using the Range.Find method, as pointed out above, along with a loop for each worksheet in the workbook, is the fastest way to do this. The following, for example, locates the string "Question?" in each worksheet and replaces it with the string "Answered!".
Sub FindAndExecute()
Dim Sh As Worksheet
Dim Loc As Range
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:="Question?")
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
Loc.Value = "Answered!"
Set Loc = .FindNext(Loc)
Loop
End If
End With
Set Loc = Nothing
Next
End Sub

Based on Ahmed's answer, after some cleaning up and generalization, including the other "Find" parameters, so we can use this function in any situation:
'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
Dim SearchResult As Range
Dim firstMatch As String
With rng
Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
If Not SearchResult Is Nothing Then
firstMatch = SearchResult.Address
Do
If FindAll Is Nothing Then
Set FindAll = SearchResult
Else
Set FindAll = Union(FindAll, SearchResult)
End If
Set SearchResult = .FindNext(SearchResult)
Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
End If
End With
End Function
Usage is the same as native .Find, but here is a usage example as requested:
Sub test()
Dim SearchRange As Range, SearchResults As Range, rng As Range
Set SearchRange = MyWorksheet.UsedRange
Set SearchResults = FindAll(SearchRange, "Search this")
If SearchResults Is Nothing Then
'No match found
Else
For Each rng In SearchResults
'Loop for each match
Next
End If
End Sub

Function GetSearchArray(strSearch)
Dim strResults As String
Dim SHT As Worksheet
Dim rFND As Range
Dim sFirstAddress
For Each SHT In ThisWorkbook.Worksheets
Set rFND = Nothing
With SHT.UsedRange
Set rFND = .Cells.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rFND Is Nothing Then
sFirstAddress = rFND.Address
Do
If strResults = vbNullString Then
strResults = "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"
Else
strResults = strResults & "|" & "Worksheet(" & SHT.Index & ").Range(" & Chr(34) & rFND.Address & Chr(34) & ")"
End If
Set rFND = .FindNext(rFND)
Loop While Not rFND Is Nothing And rFND.Address <> sFirstAddress
End If
End With
Next
If strResults = vbNullString Then
GetSearchArray = Null
ElseIf InStr(1, strResults, "|", 1) = 0 Then
GetSearchArray = Array(strResults)
Else
GetSearchArray = Split(strResults, "|")
End If
End Function
Sub test2()
For Each X In GetSearchArray("1")
Debug.Print X
Next
End Sub
Careful when doing a Find Loop that you don't get yourself into an infinite loop... Reference the first found cell address and compare after each "FindNext" statement to make sure it hasn't returned back to the first initially found cell.

You may use the Range.Find method:
http://msdn.microsoft.com/en-us/library/office/ff839746.aspx
This will get you the first cell which contains the search string. By repeating this with setting the "After" argument to the next cell you will get all other occurrences until you are back at the first occurrence.
This will likely be much faster.

Based on the idea of B Hart's answer, here's my version of a function that searches for a value in a range, and returns all found ranges (cells):
Function FindAll(ByVal rng As Range, ByVal searchTxt As String) As Range
Dim foundCell As Range
Dim firstAddress
Dim rResult As Range
With rng
Set foundCell = .Find(What:=searchTxt, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not foundCell Is Nothing Then
firstAddress = foundCell.Address
Do
If rResult Is Nothing Then
Set rResult = foundCell
Else
Set rResult = Union(rResult, foundCell)
End If
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
End If
End With
Set FindAll = rResult
End Function
To search for a value in the whole workbook:
Dim wSh As Worksheet
Dim foundCells As Range
For Each wSh In ThisWorkbook.Worksheets
Set foundCells = FindAll(wSh.UsedRange, "YourSearchString")
If Not foundCells Is Nothing Then
Debug.Print ("Results in sheet '" & wSh.Name & "':")
Dim cell As Range
For Each cell In foundCells
Debug.Print ("The value has been found in cell: " & cell.Address)
Next
End If
Next

You can read the data into an array. From there you can do the match in memory, instead of reading one cell at a time.
Pass cell contents into VBA Array

Below code avoids creating infinite loop. Assume XYZ is the string which we are looking for in the workbook.
Private Sub CommandButton1_Click()
Dim Sh As Worksheet, myCounter
Dim Loc As Range
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set Loc = .Cells.Find(What:="XYZ")
If Not Loc Is Nothing Then
MsgBox ("Value is found in " & Sh.Name)
myCounter = 1
Set Loc = .FindNext(Loc)
End If
End With
Next
If myCounter = 0 Then
MsgBox ("Value not present in this worrkbook")
End If
End Sub

Related

How to locate the last row of cells in a range which matches using VBA?

There is one column in a table where names of factories are shown but I only need the data for a specific factory name(let's say factory "Australia").
My idea is to locate the first and last rows which match because the data for the same factory are always presented in a consecutive manner. In this way, I can get the range of cells which match up to my search.
Locating the first matched row position is quite easy but I get stuck in getting the last matched row position.
Here is the code regarding this section:
Sub Search()
Dim sh As Worksheet
Dim searchStr As String
Dim lastRow As Long, firstRow as Long
Dim tableRange As range
Set sh = Worksheets("Total order")
searchStr = "Australia"
Set tableRange = sh.range("B:B").Find(what:=searchStr, LookIn:=xlValues, lookat:=xlWhole)
firstRow = tableRange.Row
End Sub
An example of the table dealt with:
Refer to the Range from the Cell of the First to the Cell of the Last Occurrence of a String in a Column
A Side Note
The Range.Find method is kind of tricky. For example, you may not be aware that in your code the search starts from cell B2 (which is even preferable in this case), and using xlValues may result in undesired results if rows are hidden (probably not important).
Usage
Using the function, according to the screenshot, you could (after searchStr = "Australia") use:
Set tableRange = refRangeFirstLast(sh.Columns("B"), searchStr)
to refer to the range B4:B7, or use:
Set tableRange = refRangeFirstLast(sh.Columns("B"), searchStr).Offset(, -1).Resize(, 4)
to refer to the range A4:D7.
The Code
Function refRangeFirstLast( _
ByVal ColumnRange As Range, _
ByVal SearchString As String) _
As Range
If Not ColumnRange Is Nothing Then
With ColumnRange
Dim FirstCell As Range: Set FirstCell = _
.Find(SearchString, .Cells(.Cells.Count), xlFormulas, xlWhole)
If Not FirstCell Is Nothing Then
Dim LastCell As Range: Set LastCell = _
.Find(SearchString, , xlFormulas, xlWhole, , xlPrevious)
Set refRangeFirstLast = .Worksheet.Range(FirstCell, LastCell)
End If
End With
End If
End Function
Sub refRangeFirstLastTEST()
Const SearchString As String = "Australia"
Dim ColumnRange As Range
Set ColumnRange = ThisWorkbook.Worksheets("Total order").Columns("B")
Dim rg As Range: Set rg = refRangeFirstLast(ColumnRange, SearchString)
If Not rg Is Nothing Then
Debug.Print rg.Address
Else
MsgBox "The reference could not be created.", vbExclamation, "Fail?"
End If
End Sub

Modify Loop to include 3 strings

I have the following code I use to go through a sheet and parse the information onto separate sheets based on the string [Start].
Private Sub CommandButton7_Click()
Application.ScreenUpdating = False
Dim i As Long, rFind As Range, rFind1 As Range, rFind2 As Range, rFind3 As Range, rFind4 As Range, ws As Worksheet, s As String, s1 As String, s2 As String
s = "[Start]"
With Sheets("Full History File").Columns(1)
Set rFind3 = .Find(What:="[HistoryEnd]", LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
Set rFind = .Cells(Rows.Count, 1)
For i = 1 To WorksheetFunction.CountIf(.Cells, "*" & s & "*")
Set rFind = .Find(What:=s, After:=rFind, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
Set rFind1 = .Find(What:=s, After:=rFind)
Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Blasted " & i
If i = WorksheetFunction.CountIf(.Cells, "*" & s & "*") Then
Set rFind1 = rFind2.Offset(1)
End If
Range(rFind, rFind1.Offset(-1)).Copy ws.Range("A1")
End If
Next i
End With
Sheets("Blast Summary Sheet").Select
SheetNames
CommandButton6.Visible = True
Application.ScreenUpdating = True
End Sub
My problem is that the information I am working through has changed and I need to adapt the code to do the following:
Search for the string [TrainingModeChanged]
If not found search for the string [TrainingMode]
If not found search for the string [Start]
Once any of the strings are found create the new sheet Blasted with the number and copy the information between the found string up until the next found string which could be either one of the 3 above.
All help in modify the code to do this would be helpfull thanks
I am not entirely sure what you are after, but you could write a function that returns your required string instead of hardcoding it. Function below:
Option Explicit
Function getString() As String
'we will use On Error Resume Next to by pass the expected error if cannot find the string
On Error Resume Next
Dim searchRng As Range
Dim mySheet As Worksheet
Set mySheet = ThisWorkbook.Sheets("Full History File")
'search for first range
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingModeChanged]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
'reset error handling
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here first search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[TrainingMode]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
'implicit to say if program runs here second search was unsuccessful
Set searchRng = mySheet.Columns(1).Find(What:="[Start]", LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
'this means search range was found
getString = searchRng.Value
On Error GoTo 0
Exit Function
End If
End Function
And you call in your routine as:
s = getString()
And then continue on with your code..

How do I get the Cell Address from a Variable VBA

I created a variable oldPassword which is populated using a VLookup.
I am trying to get now the cell address from that result but nothing seem to work.
Dim oldPassword As String
oldPassword = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, Worksheets("Employees").Range("A:B"), 2, False)
You should break the task into steps
Get a reference to the cell containing the search value
Use that reference to get the required value and address
Sub Demo
Din rSearch As Range
Dim rUser as Range
Dim rPassword As Range
Dim idx As Variant
Set rSearch = Worksheets("Employees").Range("A:B")
idx = Application.Match(Me.ComboBox1.Value, rSearch.Columns(1), 0)
If Not IsError(idx) Then
Set rUser = rSearch.Cells(idx, 1)
Set rPassword = rUser.Cells(1, 2)
' get the result
oldPassword = rPassword.Value2
' get the address
Debug.Print rPassword.Address
End If
End Sub
I would prefer using .Find as #Andreas suggested but then that is my personal preference.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Employees")
Dim aCell As Range
Set aCell = ws.Columns(1).Find(What:=ComboBox1.Value, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Dim oldPassword As String
If Not aCell Is Nothing Then
With aCell.Offset(, 1)
'~~> Do what you want with that cell
oldPassword = .Value2
MsgBox .Address
End With
Else '<~~ Optional
MsgBox ComboBox1.Value & " not found!"
End If
End Sub

Find cell(s) with certain text and add hyperlinks in a loop

tldr: Find cell(s) with part number xxxxx and add hyperlink to drawing on server.
We have a spreadsheet containing part numbers across multiple columns & rows. Our requirement is to add a hyperlink to parts' drawing, stored on our server. We have tried highlighting them as a group, but get the error
this can't be done on multiple range selection
We also want to keep the comment information intact, just to complicate it further.
Is there code we can use to search for part number xxxxx & add a hyperlink, then find the next cell and repeat the process?
We have found a "find all" code which highlights the cells, just need some help with the hyperlink issue.
Sub FindAll()
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
'What value do you want to find (must be in string form)?
fnd = "70005"
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
'Find next cell with fnd value
Set FoundCell = myRange.FindNext(after:=FoundCell)
'Add found cell to rng range variable
Set rng = Union(rng, FoundCell)
'Test to see if cycled through to first found cell
If FoundCell.Address = FirstFound Then Exit Do
Loop
'Select Cells Containing Find Value
rng.Select
Exit Sub
'Error Handler
NothingFound:
MsgBox "No values were found in this worksheet"
End Sub
Your method can be simplified a bit. My suggestion is to create a function that will add your hyperlinks to any given area.
My test data is
Option Explicit
Sub test()
Dim linkCount As Long
linkCount = AddHyperLinkTo(FindArea:=Sheet1.UsedRange, _
FindThis:="red", _
Link:="https://google.com")
Debug.Print "found: " & linkCount
End Sub
Function AddHyperLinkTo(ByRef FindArea As Range, _
ByVal FindThis As Variant, _
ByVal Link As String) As Long
Dim numberFound As Long
Dim parentWS As Worksheet
Set parentWS = FindArea.Parent
Dim firstFind As Range
Dim findResult As Range
Set findResult = FindArea.Find(What:=FindThis, LookIn:=xlValues)
Set firstFind = findResult
Do Until findResult Is Nothing
parentWS.Hyperlinks.Add Anchor:=findResult, Address:=Link
numberFound = numberFound + 1
Set findResult = FindArea.Find(What:=FindThis, LookIn:=xlValues, After:=findResult)
If findResult.Address = firstFind.Address Then
Exit Do
End If
Loop
AddHyperLinkTo = numberFound
End Function

Delete rows in Excel using VBA by finding column and value within column

I am trying to build a macro which will find a column with the header "Total Labor" and delete all rows which have "0" in that column. I am generating multiple reports and the "Total Labor" column will change position so that's why I need the find. So far I have this code but when I run it nothing happens. Any help is appreciated.
Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
Set FoundCell = rng.Find(what:="0")
Do Until FoundCell Is Nothing
FoundCell.EntireRow.Delete
Set FoundCell = rng.FindNext
Loop
End Sub
First: if you set Application.ScreenUpdating = False be sure that you reset it to True before the sub ends. If your macro crashes you could find yourself unable to work with the application until you restart Excel or run another macro that sets Application.ScreenUpdating = True
Now, to answer your question: The problem with your code is that rng as defined in your code is only going to be the cell containing "Total Labor". When you search for a value of "0" in that range, the line Set FoundCell = rng.Find(what:="0") evaluates to "Nothing", so when you start the do loop, it meets the criterion of FoundCell Is Nothing and immediately goes to End Sub.
Something like this should do the trick:
Sub DeleteRows2()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
'~~>dim variables and set initial values
Dim rTotalLaborHeader As Range
Set rTotalLaborHeader = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
Dim rTotalLaborColumn As Range
Set rTotalLaborColumn = Range(Cells(2, rTotalLaborHeader.Column), Cells(1048576, rTotalLaborHeader.Column).End(xlUp))
'Set rTotalLaborColumn = Range(rTotalLaborHeader.Offset(1, 0), rTotalLaborHeader.End(xlDown))
Dim rLaborRow As Range
'~~>Loop to delete rows with zero Total Labor
For Each rLaborRow In rTotalLaborColumn
If rLaborRow.Value = 0 Then rLaborRow.EntireRow.Delete
Next rLaborRow
CleanupAndExit:
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Resume CleanupAndExit
End Sub
How about:
Sub DeleteRow()
Dim colly As Long, killer As Range, nRow As Long
colly = 0
For i = 1 To Columns.Count
If Cells(1, i).Value = "Total Labor" Then
colly = i
Exit For
End If
Next i
If colly = 0 Then
MsgBox "Header not found"
Exit Sub
End If
nRow = Cells(Rows.Count, colly).End(xlUp).Row
For i = 1 To nRow
If Cells(i, colly).Value = 0 Then
If killer Is Nothing Then
Set killer = Cells(i, colly)
Else
Set killer = Union(killer, Cells(i, colly))
End If
End If
Next i
If killer Is Nothing Then
Else
killer.EntireRow.Delete
End If
End Sub
You need to replicate the FindAll functionality that the Excel UI Provides. Here's a code-list for achieving that in VBA. Save this to a .bas file, then call it in your macro after you locate 'Total Labor' and then look through the range you get back from FindAll and execute .Delete on them.
Sub DeleteRows()
Dim FoundCell As Range
Dim rng As Range
Application.ScreenUpdating = False
Set rng = Worksheets(ActiveSheet.Name).Range("A1:BB100").Find(what:="Total Labor", _
LookAt:=xlWhole, MatchCase:=False)
If rng Is Nothing Then
Msgbox "Total Labor Not Found"
Else
Set SearchRange = rng.EntireColumn
FindWhat = "0"
Set FoundCells = FindAll(SearchRange:=SearchRange, _
FindWhat:=FindWhat, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
If FoundCells Is Nothing Then
Debug.Print "Value Not Found"
Else
For Each FoundCell In FoundCells
FoundCell.EntireRow.Delete
Next FoundCell
End If
End If
End Sub
FindAll Source Code: http://www.cpearson.com/excel/findall.aspx
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
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result. If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 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
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

Resources