How to generate a file copy of the Excel Find results list

Can anyone help? In Excel the Find command manages to generate a long
list of result items (13,000). How do you obtain a file copy of the
Find results?

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


MrSpreadsheet wrote:
>
> Can anyone help? In Excel the Find command manages to generate a long
> list of result items (13,000). How do you obtain a file copy of the
> Find results?

--

Dave Peterson

The testme macro ran as expected and produced results in exactly the
right order, thank you.

In testing there were two exceptions a) any cell containing a string
similar to '===== halted the macro and b) oRow greater than the max
allowed in Excel runs 'forever'.

Is it important to fix?

Option Explicit
Sub testme01()

Dim curWkbk As Workbook
Dim wks As Worksheet
Dim RptWks As Worksheet
Dim oRow As Long
Dim MaxRows As Long
Dim oCol 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)

MaxRows = 40000
oRow = 99999
oCol = -3
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
If oRow > MaxRows - 1 Then
If oCol > 252 Then
Set RptWks = RptWks.Parent.Worksheets.Add
oCol = -3
End If
oCol = oCol + 4
RptWks.Cells(1, oCol).Resize(1, 4).Value _
= Array("Worksheet Name", "Address", _
"Value", "Formula")
oRow = 1
End If
oRow = oRow + 1

With RptWks.Cells(oRow, oCol)
.Value = "'" & FoundCell.Parent.Name
.Offset(0, 1).Value = FoundCell.Address
With .Offset(0, 2)
.Value = "'" & FoundCell.Text
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

This addresses the running out of rows problem (and running out of columns).

But I weaseled out on the '===== stuff.

When you put that ==== in a cell, excel sees it as the beginning of a formula.
And it's not a nice formula.

There are other things that can cause this trouble, too. Plus, minus (+/-) and
excel will think you're starting another formula. And if your value looks like
a date (12/15/05), excel will interpret it as a date. (same thing with time).

So instead of fiddling with it, I just chose to show the text of the cell--not
the value (and I put a single quote in front).

With .Offset(0, 2)
.Value = "'" & FoundCell.Text
End With





MrSpreadsheet wrote:
>
> The testme macro ran as expected and produced results in exactly the
> right order, thank you.
>
> In testing there were two exceptions a) any cell containing a string
> similar to '===== halted the macro and b) oRow greater than the max
> allowed in Excel runs 'forever'.

--

Dave Peterson

A great macro that's been applied in an increasing number of ways.
Thank you.

The save file is in Excel and a long list of find results that reach
row max start again in a new set of columns. How would the macro be
adapted to save find results as a continuous list in Word (.doc) or as
a Comma Separated Values (csv) file ?


Dave Peterson wrote:
> Is it important to fix?
>
> Option Explicit
> Sub testme01()
>
> Dim curWkbk As Workbook
> Dim wks As Worksheet
> Dim RptWks As Worksheet
> Dim oRow As Long
> Dim MaxRows As Long
> Dim oCol 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)
>
> MaxRows = 40000
> oRow = 99999
> oCol = -3
> 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
> If oRow > MaxRows - 1 Then
> If oCol > 252 Then
> Set RptWks = RptWks.Parent.Worksheets.Add
> oCol = -3
> End If
> oCol = oCol + 4
> RptWks.Cells(1, oCol).Resize(1, 4).Value _
> = Array("Worksheet Name", "Address", _
> "Value", "Formula")
> oRow = 1
> End If
> oRow = oRow + 1
>
> With RptWks.Cells(oRow, oCol)
> .Value = "'" & FoundCell.Parent.Name
> .Offset(0, 1).Value = FoundCell.Address
> With .Offset(0, 2)
> .Value = "'" & FoundCell.Text
> 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
>
> This addresses the running out of rows problem (and running out of
columns).
>
> But I weaseled out on the '===== stuff.
>
> When you put that ==== in a cell, excel sees it as the beginning of a
formula.
> And it's not a nice formula.
>
> There are other things that can cause this trouble, too. Plus, minus
(+/-) and
> excel will think you're starting another formula. And if your value
looks like
> a date (12/15/05), excel will interpret it as a date. (same thing
with time).
>
> So instead of fiddling with it, I just chose to show the text of the
cell--not
> the value (and I put a single quote in front).
>
> With .Offset(0, 2)
> .Value = "'" & FoundCell.Text
> End With
>
>
>
>
>
> MrSpreadsheet wrote:
> >
> > The testme macro ran as expected and produced results in exactly
the
> > right order, thank you.
> >
> > In testing there were two exceptions a) any cell containing a
string
> > similar to '===== halted the macro and b) oRow greater than the max
> > allowed in Excel runs 'forever'.
>
> --
>
> Dave Peterson