This macro will search Column B3:B of sheet €˜Statement for text €˜Agent.
When found it copies that row of Columns O:AG and pastes the data into sheet
€˜Examine range O1:AG1. Sometimes the text €˜Agent is not in Column B, when
that happens I get an error message to debug the macro. Do you know what I
can do to this macro so that I wont get a message to debug even when the
text €˜Agent cannot be found in Column B?


Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range
Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
If CopyRng.SpecialCells(xlCellTypeVisible).Rows.Count 0 Then
CopyRng.SpecialCells(xlCellTypeVisible).Offset(0, 3).Resize _
(CopyRng.SpecialCells(xlCellTypeVisible).Rows.Coun t, 31).Copy _
Destination:=Sheets("Examine").Range("O1")
End If

Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Hi Teddy,

Firstly rows cannot be counted with Rows.count in non contiguous ranges such
as Autofiltered rows. The count stops at the first non contiguous row.
However, cells can be counted and because you are only applying Autofilter to
one column, counting the cells will tell you if Agent is present.

I think that using Autofilter.Range as per the following example is the way
to go.

A few explanations of the code. (Space and underscore at the end of a line
is a line break in an otherwise single line of code.)

With .AutoFilter.Range
AutoFilter.Range is the actual range to which Autofilter has been applied.
In this case it is column B and it includes the column header.

..Columns(1).SpecialCells _
(xlCellTypeVisible) _
.Cells.Count 1
Looking at the total visible cells in columns(1) of the AutoFiltered range.
Note it includes the column header so for data to be present it must be
greater than 1.

Set CopyRng = .Offset(1, 13) _
.Resize(.Rows.Count - 1, 19) _
.SpecialCells(xlCellTypeVisible)

..Offset(1, 13) moves range down one row off the column headers but that then
includes an extra row at the bottom. The 13 shifts the range across 13
columns which in this case is column O. (Note it moves 13 columns across not
to column 13)

..Resize(.Rows.Count - 1, 19) removes the extra row from the bottom and then
the 19 is to include a total of 19 columns. This will now be columns O to AG.

..SpecialCells(xlCellTypeVisible) is self explanatory.

Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range
Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"

With .AutoFilter.Range
'Test that more than header cells visible.
If .Columns(1).SpecialCells _
(xlCellTypeVisible) _
.Cells.Count 1 Then

Set CopyRng = .Offset(1, 13) _
.Resize(.Rows.Count - 1, 19) _
.SpecialCells(xlCellTypeVisible)

CopyRng.Copy _
Destination:=Sheets("Examine") _
.Range("O1")
End If
End With
End With

Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

--
Regards,

OssieMac

Try this one.

Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range, CopyRngF As Range

Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
On Error Resume Next
Set CopyRngF = CopyRng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not CopyRngF Is Nothing Then
CopyRng.Offset(0, 13).Resize _
(, 19).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Examine").Range("O1")
End If
Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Keiji

Teddy wrote:
This macro will search Column B3:B of sheet €˜Statement for text €˜Agent.
When found it copies that row of Columns O:AG and pastes the data into sheet
€˜Examine range O1:AG1. Sometimes the text €˜Agent is not in Column B, when
that happens I get an error message to debug the macro. Do you know what I
can do to this macro so that I wont get a message to debug even when the
text €˜Agent cannot be found in Column B?


Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range
Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
If CopyRng.SpecialCells(xlCellTypeVisible).Rows.Count 0 Then
CopyRng.SpecialCells(xlCellTypeVisible).Offset(0, 3).Resize _
(CopyRng.SpecialCells(xlCellTypeVisible).Rows.Coun t, 31).Copy _
Destination:=Sheets("Examine").Range("O1")
End If

Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

OssieMac this is an incredible explanation. Thank you for taking the time
out to teach me. I appreciate it very much. Also the macro is outstanding.
Thank you for helping me to resolve the problem I was having. I am thankful
for the help.

"OssieMac" wrote:

Hi Teddy,

Firstly rows cannot be counted with Rows.count in non contiguous ranges such
as Autofiltered rows. The count stops at the first non contiguous row.
However, cells can be counted and because you are only applying Autofilter to
one column, counting the cells will tell you if Agent is present.

I think that using Autofilter.Range as per the following example is the way
to go.

A few explanations of the code. (Space and underscore at the end of a line
is a line break in an otherwise single line of code.)

With .AutoFilter.Range
AutoFilter.Range is the actual range to which Autofilter has been applied.
In this case it is column B and it includes the column header.

.Columns(1).SpecialCells _
(xlCellTypeVisible) _
.Cells.Count 1
Looking at the total visible cells in columns(1) of the AutoFiltered range.
Note it includes the column header so for data to be present it must be
greater than 1.

Set CopyRng = .Offset(1, 13) _
.Resize(.Rows.Count - 1, 19) _
.SpecialCells(xlCellTypeVisible)

.Offset(1, 13) moves range down one row off the column headers but that then
includes an extra row at the bottom. The 13 shifts the range across 13
columns which in this case is column O. (Note it moves 13 columns across not
to column 13)

.Resize(.Rows.Count - 1, 19) removes the extra row from the bottom and then
the 19 is to include a total of 19 columns. This will now be columns O to AG.

.SpecialCells(xlCellTypeVisible) is self explanatory.

Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range
Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"

With .AutoFilter.Range
'Test that more than header cells visible.
If .Columns(1).SpecialCells _
(xlCellTypeVisible) _
.Cells.Count 1 Then

Set CopyRng = .Offset(1, 13) _
.Resize(.Rows.Count - 1, 19) _
.SpecialCells(xlCellTypeVisible)

CopyRng.Copy _
Destination:=Sheets("Examine") _
.Range("O1")
End If
End With
End With

Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

--
Regards,

OssieMac

This is a very good macro. Thank you for stepping in and lending a hand. I
needed the help. I appreciate it very much. The macro works very well.
Thank you!

"keiji kounoike" <"kounoike A | T ma.Pik" wrote:

Try this one.

Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range, CopyRngF As Range

Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
On Error Resume Next
Set CopyRngF = CopyRng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not CopyRngF Is Nothing Then
CopyRng.Offset(0, 13).Resize _
(, 19).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Examine").Range("O1")
End If
Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Keiji

Teddy wrote:
This macro will search Column B3:B of sheet €˜Statement for text €˜Agent.
When found it copies that row of Columns O:AG and pastes the data into sheet
€˜Examine range O1:AG1. Sometimes the text €˜Agent is not in Column B, when
that happens I get an error message to debug the macro. Do you know what I
can do to this macro so that I wont get a message to debug even when the
text €˜Agent cannot be found in Column B?


Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range
Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
If CopyRng.SpecialCells(xlCellTypeVisible).Rows.Count 0 Then
CopyRng.SpecialCells(xlCellTypeVisible).Offset(0, 3).Resize _
(CopyRng.SpecialCells(xlCellTypeVisible).Rows.Coun t, 31).Copy _
Destination:=Sheets("Examine").Range("O1")
End If

Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub


.

Thank you for your feedback.

Keiji

Teddy wrote:
This is a very good macro. Thank you for stepping in and lending a hand. I
needed the help. I appreciate it very much. The macro works very well.
Thank you!

"keiji kounoike" <"kounoike A | T ma.Pik" wrote:

Try this one.

Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range, CopyRngF As Range

Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
On Error Resume Next
Set CopyRngF = CopyRng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not CopyRngF Is Nothing Then
CopyRng.Offset(0, 13).Resize _
(, 19).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Examine").Range("O1")
End If
Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Keiji

Teddy wrote:
This macro will search Column B3:B of sheet €˜Statement for text €˜Agent.
When found it copies that row of Columns O:AG and pastes the data into sheet
€˜Examine range O1:AG1. Sometimes the text €˜Agent is not in Column B, when
that happens I get an error message to debug the macro. Do you know what I
can do to this macro so that I wont get a message to debug even when the
text €˜Agent cannot be found in Column B?


Sub FindPaste()
Dim FilterRng As Range
Dim CopyRng As Range
Application.ScreenUpdating = False

With Sheets("Statement")
Set FilterRng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Set CopyRng = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
End With

FilterRng.AutoFilter Field:=1, Criteria1:="Agent"
If CopyRng.SpecialCells(xlCellTypeVisible).Rows.Count 0 Then
CopyRng.SpecialCells(xlCellTypeVisible).Offset(0, 3).Resize _
(CopyRng.SpecialCells(xlCellTypeVisible).Rows.Coun t, 31).Copy _
Destination:=Sheets("Examine").Range("O1")
End If

Sheets("Statement").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub


.