Need to Copy and Paste results of Find All

  • Thread starter Thread starter JG Scott
  • Start date Start date
J

JG Scott

When I use the Edit/Find All dialog in Excel, I would like to be able
to copy/paste and print the resulting lists of references. Does anyone
know a way to do so?
 
How about a macro?

Saved from a previous post...

But you could use a macro...

Option Explicit
Sub testme01()

Dim curWkbk As Workbook
Dim wks As Worksheet
Dim RptWks As Worksheet
Dim oRow As Long

Dim FoundCell As Range
Dim FirstAddress As String
Dim FindWhat As String

FindWhat = InputBox(Prompt:="Find What?")
If FindWhat = "" Then
Exit Sub
End If

Set curWkbk = ActiveWorkbook
Set RptWks = Workbooks.Add(1).Worksheets(1)

With RptWks
.Range("a1").Resize(1, 4).Value _
= Array("Worksheet Name", "Address", "Value", "Formula")
End With

oRow = 1
For Each wks In curWkbk.Worksheets
With wks.Cells
Set FoundCell = .Find(what:=FindWhat, lookat:=xlPart, _
LookIn:=xlFormulas, _
after:=.Cells(.Cells.Count), _
searchdirection:=xlNext, MatchCase:=False)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
oRow = oRow + 1
With RptWks.Cells(oRow, "A")
.Value = "'" & FoundCell.Parent.Name
.Offset(0, 1).Value = FoundCell.Address
With .Offset(0, 2)
.Value = FoundCell.Value
.NumberFormat = FoundCell.NumberFormat
End With
If FoundCell.HasFormula Then
.Offset(0, 3).Value = "'" & FoundCell.Formula
End If
End With
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next wks

End Sub

It does the same as edit|find. Which means that it won't find stuff in cells
hidden by an autofilter (for example).

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
Back
Top