Sub FindAll()
Dim wks As Worksheet, wksOut As Worksheet
Dim colFoundRanges As Collection
Dim strFind As String
Dim lngIndex As Long
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Find results").Delete
Application.DisplayAlerts = True
Set wksOut = Worksheets.Add
wksOut.Name = "Find results"
Set colFoundRanges = New Collection
strFind = InputBox("Enter string to find")
For Each wks In ActiveWorkbook.Worksheets
FindCells wks, strFind, colFoundRanges
Next wks
With colFoundRanges
For lngIndex = 1 To .Count
With .Item(lngIndex)
wksOut.Cells(lngIndex, 1).Value = .Parent.Name
wksOut.Cells(lngIndex, 2).Value = .Address
wksOut.Cells(lngIndex, 3).Value = "'" & .Formula
End With
Next lngIndex
End With
End Sub
Sub FindCells(ws As Worksheet, strToFind As String, colOutput As Collection)
Dim strFirstAddress As String
Dim rngFound As Range
With ws.UsedRange
Set rngFound = .Find(what:=strToFind, lookat:=xlPart, LookIn:=xlFormulas, MatchCase:=False)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
colOutput.Add rngFound, ws.Name & "-" & rngFound.Address
Set rngFound = .FindNext(rngFound)
Loop While rngFound.Address <> strFirstAddress
End If
End With
End Sub
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
From novice to tech pro — start learning today.
pls try (.Parent.Parent.Name)
Open in new window
Regards