Prev: Converting MS query from Excel 2003 to Excel 2007
Next: Apply format to >0 cells
From: Teddy on 5 Mar 2010 21:35
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 won't 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.Count, 31).Copy _
Destination:=Sheets("Examine").Range("O1")
End If

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


From: OssieMac on 6 Mar 2010 01:21
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


From: keiji kounoike "kounoike A | T on 6 Mar 2010 03:47
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 won't 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.Count, 31).Copy _
> Destination:=Sheets("Examine").Range("O1")
> End If
>
> Sheets("Statement").AutoFilterMode = False
> Application.ScreenUpdating = True
> End Sub
>
>
From: Teddy on 7 Mar 2010 15:47
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
>
>
From: Teddy on 7 Mar 2010 15:48
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 won't 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.Count, 31).Copy _
> > Destination:=Sheets("Examine").Range("O1")
> > End If
> >
> > Sheets("Statement").AutoFilterMode = False
> > Application.ScreenUpdating = True
> > End Sub
> >
> >
> .
>
 |  Next  |  Last
Pages: 1 2
Prev: Converting MS query from Excel 2003 to Excel 2007
Next: Apply format to >0 cells