Search for text in every sheet]

[loveguy1977]

Dear Sirs,

Below is a VBA that will search for (Sales_By_AAA) in all sheets if find then the sub will stop and select the cell that find the text. This takes time to do so because will go thru all sheets which more than 15 sheets.

I need this vba to search in 3 sheets only namely "Sale1", "Sale2", & "Sale8"


Sub Search_EveryWhere()
On Error GoTo ErrEndSub
Application.EnableEvents = False
Dim searchText As String
searchText = "Sales_By_AAA"
If Not searchText = "" Then
Dim r As Range
Dim findNext As Integer
findNext = vbYes
Dim i As Integer
For i = 1 To Sheets.Count
If Sheets.Item(i).Visible = xlSheetVisible Then
Dim Sheet As Worksheet
Set Sheet = Sheets.Item(i)
Dim firstFoundCell As String
firstFoundCell = ""
Dim looped As Boolean
looped = False
Do While findNext = vbYes And Not looped
Sheets(Sheet.Name).Select
Set r = Cells.Find(searchText, ActiveCell, xlValues, xlWhole, xlByRows, xlNext, False)
If r Is Nothing Then
Exit Do
Else
r.Activate
If firstFoundCell = "" Then
Sheet.Activate
firstFoundCell = r.Address
Else
If r.Address = firstFoundCell Then
looped = True
Else
End If
End If
If Not looped Then
Cancel = True
GoTo ErrEndSub
End If
End If
Loop
End If
Next i
If findNext = vbYes Then
End If
End If
ErrEndSub:
Application.EnableEvents = True
End Sub

[Kenneth Hobs]

You can get my speed module or comment out SpeedOn and SpeedOff.


Sub Test_FoundRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long
Dim e As Variant, s() As Variant
On Error GoTo EndNow:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn
s() = Array("Sale1", "Sale2", "Sale8")
For Each e In s()
If Not WorkSheetExists(CStr(e)) Then GoTo NextE
Set findRange = Worksheets(e).UsedRange
findString = "Sales_By_AAA"
Set foundRange = FoundRanges(findRange, findString)
If foundRange Is Nothing Then GoTo NextE
If Not foundRange Is Nothing Then
foundRange.Worksheet.Select
foundRange.Select
GoTo EndNow
End If
NextE:
Next e
EndNow:
SpeedOff
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String
With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function

'WorkSheetExists in a workbook:

Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim ws As Worksheet, wb As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set wb = ActiveWorkbook
Else
Set wb = Workbooks(sWorkbook)
End If
Set ws = wb.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function

[loveguy1977]

Thank you very much

but it is not working until I do some changes as below. My another need is if nothing find then run another macro. In fact, your macro if nothing find then will stop and will not allow another macro to run. I would appreciate if you modify it.

Actually, I that text found then stop running another macro until I do the necessary thing then I will run it again until found nothing

This is working with me

Sub Test_FoundRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long
Dim e As Variant, s() As Variant
On Error GoTo ErrEndSub
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
'SpeedOn
Application.EnableEvents = False
s() = Array("Sheet1", "Sheet5", "Sheet9")
For Each e In s()
If Not WorkSheetExists(CStr(e)) Then GoTo ErrEndSub 'NextE
Set findRange = Worksheets(e).UsedRange
findString = "Sales_By_AAA"
Set foundRange = FoundRanges(findRange, findString)
If foundRange Is Nothing Then GoTo ErrEndSub 'NextE
If Not foundRange Is Nothing Then
foundRange.Worksheet.Select
foundRange.Select
On Error GoTo ErrEndSub
'GoTo EndNow
End If
'NextE:
Next e
ErrEndSub:
Application.EnableEvents = True
'EndNow:
' SpeedOff
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String
With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .findNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundRanges = rFound
End Function

'WorkSheetExists in a workbook:

Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim ws As Worksheet, wb As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set wb = ActiveWorkbook
Else
Set wb = Workbooks(sWorkbook)
End If
Set ws = wb.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function