Font Filter & loop Macro not quite working

[Karlos]

Hi, Ive had to start a new thread, I can't find my last one with the same question which may well have been answered - appologies and thanks if it has.

below is macro that Tom provided which was a great help and again thanks, (Tom)

The problem is that it wont go pass one loop and comes back with run time error 91.

This only happens if the "search" criteria is matched, if I,m looking for "stuff" and ithe text "stuff" is in the spreadsheet I get the error 91 and it halts. If "stuff" is not in the spreadsheet, no error is reported.

I also looking for the best way of deleting the rows in the new sheet, would a seperate macro be best in sheet2 or could it be combined?

Sub Extract()
Dim rng As Range, cell As Range
With Worksheets("Sheet1")
Set rng = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In rng
If cell.Font.Size = 14 Then
cell.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(cell.Row, 1)
End If
Next
Set rng = Worksheets("Sheet1").Cells.find("Stuff", _
LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(rng.Row, 1)
Set rng = cell.FindNext(rng)
Loop Until rng.Address = sAddr
End If
End Sub

[Tom Ogilvy]

Sub Extract()
Dim rng As Range, cell As Range
With Worksheets("Sheet1")
Set rng = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In rng
If cell.Font.Size = 14 Then
cell.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(cell.Row, 1)
End If
Next
Set rng = Worksheets("Sheet1").Cells.find("Stuff", _
LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(rng.Row, 1)

Set rng = Worksheets("Sheet1") _
cells.FindNext(rng)
Loop Until rng.Address = sAddr
End If
End Sub

--
Regards,
Tom Ogilvy


"Karlos" <[email protected]> wrote in
message news:[email protected]...
>
> Hi, Ive had to start a new thread, I can't find my last one with the
> same question which may well have been answered - appologies and thanks
> if it has.
>
> below is macro that Tom provided which was a great help and again
> thanks, (Tom)
>
> The problem is that it wont go pass one loop and comes back with run
> time error 91.
>
> This only happens if the "search" criteria is matched, if I,m looking
> for "stuff" and ithe text "stuff" is in the spreadsheet I get the error
> 91 and it halts. If "stuff" is not in the spreadsheet, no error is
> reported.
>
> I also looking for the best way of deleting the rows in the new sheet,
> would a seperate macro be best in sheet2 or could it be combined?
>
> Sub Extract()
> Dim rng As Range, cell As Range
> With Worksheets("Sheet1")
> Set rng = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
> End With
> For Each cell In rng
> If cell.Font.Size = 14 Then
> cell.EntireRow.Copy Destination:= _
> Worksheets("Sheet2").Cells(cell.Row, 1)
> End If
> Next
> Set rng = Worksheets("Sheet1").Cells.find("Stuff", _
> LookIn:=xlValues, LookAt:=xlPart)
> If Not rng Is Nothing Then
> sAddr = rng.Address
> Do
> rng.EntireRow.Copy Destination:= _
> Worksheets("Sheet2").Cells(rng.Row, 1)
> Set rng = cell.FindNext(rng)
> Loop Until rng.Address = sAddr
> End If
> End Sub
>
>
> --
> Karlos
> ------------------------------------------------------------------------
> Karlos's Profile:
http://www.excelforum.com/member.php...o&userid=28649
> View this thread: http://www.excelforum.com/showthread...hreadid=484004
>