Modify Loop to include 3 strings - excel

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..

Related

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

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

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

Replace #Ref over within several Ranges

New to coding so sorry if I'm completely ignoring contexts as I'm still trying to learn them.
I have cells that are trying to pull data from several Pivot Tables in another worksheet. If it is unable to pull any information from the pivot tables, it will return #REF. The Macro is supposed to search through in each cell within several ranges to search for the #REF and replace it with a 0. The reason its several ranges instead of the entire worksheet is that some of the equations are trying to add values from a table and since some of those values are #REF, the sum also ends up being #REF. I need to keep those equations there so once the #REF's are replaced, they would get the sum.
Dim Areas(13) As Range
Set Areas(1) = Range("C5:Z7")
Set Areas(2) = Range("C10:Z14")
Set Areas(3) = Range("C27:Z27")
Set Areas(4) = Range("C33:Z45")
Set Areas(5) = Range("C52:Z55")
Set Areas(6) = Range("C58:Z61")
Set Areas(7) = Range("C63:Z66")
Set Areas(8) = Range("C68:Z72")
Set Areas(9) = Range("C74:Z78")
Set Areas(10) = Range("C80:Z84")
Set Areas(11) = Range("C86:Z90")
Set Areas(12) = Range("C92:Z96")
Set Areas(13) = Range("C102:Z112")
For R = 1 To 13
For Each cell In Areas(R) 'Error: For Each may only iterate over a collection object
If cell.Value = CVErr(xlErrName) Then
.Replace What:="#REF!", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Else
Next
I made a bunch of notes after my code to try to work off of based on other StackOverflow questions which I listed below. I figured they worked will form a single range but I'm working with several. If none of what I did makes sense then disregard the below and help me start over. (Please?) Let me know if you need any more information.
If IsError(cell.Value) Then
' If cell.Value = CVErr(xlErrName) Then
' ...
' End If
'End If
'Dim nm As Name
' For Each nm In ActiveWorkbook.Names
' If InStr(nm.Value, "#REF!") > 0 Then
' nm.Delete
' End If
'Next nm
' ActiveCell.Replace What:="#REF!", Replacement:="0", LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False
'With Range("B11:AP55").SpecialCells(xlCellTypeFormulas)
' .Formula = Replace(.Formula, "#REF", "Master", , , vbTextCompare)
'End With
As an alternative to Find, consider SpecialCells
To remove only #REF errors
Sub Demo1()
Dim rng As Range
Dim rErr As Range
Dim cl As Range
With ActiveSheet 'or specify a specific sheet
Set rng = .Range("C5:Z7,C10:Z14,C27:Z27,C33:Z45,C52:Z55,C58:Z61,C63:Z66,C68:Z72,C74:Z78,C80:Z84,C86:Z90,C92:Z96,C102:Z112")
End With
On Error Resume Next
Set rErr = rng.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Not rErr Is Nothing Then
For Each cl In rErr.Cells
If cl.Value = CVErr(xlErrRef) Then
cl.Offset(0, 1) = 0
End If
Next
End If
End Sub
To remove All errors:
Sub Demo2()
Dim rng As Range
Dim rErr As Range
With ActiveSheet 'or specify a specific sheet
Set rng = .Range("C5:Z7,C10:Z14,C27:Z27,C33:Z45,C52:Z55,C58:Z61,C63:Z66,C68:Z72,C74:Z78,C80:Z84,C86:Z90,C92:Z96,C102:Z112")
End With
On Error Resume Next
Set rErr = rng.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0
If Not rErr Is Nothing Then
rErr = 0
End If
End Sub

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

.FindNext failing after a .Find function (excel vba)

I am trying to use .Find and .FindNext to search through a single column of data. I first need to find the first cell containing the value "Total". The cell I'm trying to get to is the third cell AFTER the "Total" cell to contain the value "Tech". It is known for certain that the Cells(1, 1) does not contain "Tech" or "Total".
Dim FirstTotal As Range
Dim SearchRng As Range
Dim ResultRng As Range
Set SearchRng = Range("A:A")
Set FirstTotal = SearchRng.Find(What:="Total", After:=Cells(1, 1), SearchDirection:=xlNext)
Set ResultRng = SearchRng.Find(What:="Tech", After:=FirstTotal, SearchDirection:=xlNext)
SearchRng.FindNext().Activate
SearchRng.FindNext().Activate
About 50% of the times I've run this code, I've been stopped by a type mismatch error on the line beginning with Set ResultRng =. The rest of the time, the code has run all the way through, but the results look as though the final two lines of code were ignored completely.
I suspect that the answer here is pretty elementary, but I'm pretty new to excel vba and no resources I've found so far have answered this. Please help!
Would this help?
Sub Sample()
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, FoundAt As String
On Error GoTo Err
Set ws = Worksheets("Sheet3")
Set oRange = ws.Columns(1)
SearchString = "2"
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
FoundAt = aCell.Address
Do
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
FoundAt = FoundAt & ", " & aCell.Address
Else
Exit Do
End If
Loop
Else
MsgBox SearchString & " not Found"
End If
MsgBox "The Search String has been found at these locations: " & FoundAt
Exit Sub
Err:
MsgBox Err.Description
End Sub
If "Total" isn't found, then FirstTotal will be Nothing, which will result in a Type Mismatch when you try to use FirstTotal for the "After" argument in the ResultRange Find (the 2nd line). This will prevent that error:
Set FirstTotal = SearchRng.Find(What:="Total", After:=Cells(1, 1), SearchDirection:=xlNext)
If Not FirstTotal is Nothing Then
Set ResultRng = SearchRng.Find(What:="Tech", After:=FirstTotal, SearchDirection:=xlNext)
End If
Generally speaking any dependent Finds need to be treated this way.
Clearly, some kind of Else statement is required here, but I don't know what that would be.
I have observed the FindNext method fail to find the next occurrence of the searched item when applied in a function with parameters, which is invoked from a cell. The Find method (to search the first occurrence) does work as expected.

Resources