Copy function with using criteria
 

Hi,

I am trying to create a macro that will, when a command button is clicked,
copy a row and format it the same from one sheet to another if the color of
the font in one of the cells of that row, let's say column E, is red or
yellow.

Also, if it doesn't copy one row, I would like it to paste the next row
fitting the above font color conditions on the line right below in the new
sheet.

Copy function with using criteria
 

Private Sub CommandButton1_Click()
Dim rng as Range
set rng = cells(activeCell.Row,"E")
do
if rng.Font.ColorIndex = 3 then
rng.EntireRow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
exit do
end if
set rng = rng.offset(1,0)
Loop Until isempty(rng)
msgbox "No row meeting conditions was found"
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp." <Jeff at Robert Bosch
wrote in message
...
Hi,

I am trying to create a macro that will, when a command button is clicked,
copy a row and format it the same from one sheet to another if the color
of
the font in one of the cells of that row, let's say column E, is red or
yellow.

Also, if it doesn't copy one row, I would like it to paste the next row
fitting the above font color conditions on the line right below in the new
sheet.

Copy function with using criteria
 

I tried this code and it only copied the first cell with red font.. It
didn't copy the cells below it that also had red text. I had text in E1:E20
and E2, E5, E8, E11, E14, E17, E20 had red text. Does the top cell in column
E have to be selected before I click the command button?

Thanks,
Jeff Granger

"Tom Ogilvy" wrote:

Private Sub CommandButton1_Click()
Dim rng as Range
set rng = cells(activeCell.Row,"E")
do
if rng.Font.ColorIndex = 3 then
rng.EntireRow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
exit do
end if
set rng = rng.offset(1,0)
Loop Until isempty(rng)
msgbox "No row meeting conditions was found"
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp." <Jeff at Robert Bosch
wrote in message
...
Hi,

I am trying to create a macro that will, when a command button is clicked,
copy a row and format it the same from one sheet to another if the color
of
the font in one of the cells of that row, let's say column E, is red or
yellow.

Also, if it doesn't copy one row, I would like it to paste the next row
fitting the above font color conditions on the line right below in the new
sheet.

Copy function with using criteria
 

There was nothing in your description that would lead me to believe you
wanted to copy all rows in column E that had a red font.

In any event.

Private Sub CommandButton1_Click()
Dim rng as Range, rng1 as Range
Dim cell as Range
set rng = Range(cells(1,"E"),cells(rows.count,"E").End(xlup) )
for each cell in rng
if cell.Font.ColorIndex = 3 then
if rng1 is nothing then
set rng1 = cell
else
set rng1 = union(rng1,cell)
end if
End if
Next cell
if not rng1 is nothing then
rng1.Entirerow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
else
msgbox "No cells met criteria"
End if
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp."
wrote in message
...
I tried this code and it only copied the first cell with red font.. It
didn't copy the cells below it that also had red text. I had text in
E1:E20
and E2, E5, E8, E11, E14, E17, E20 had red text. Does the top cell in
column
E have to be selected before I click the command button?

Thanks,
Jeff Granger

"Tom Ogilvy" wrote:

Private Sub CommandButton1_Click()
Dim rng as Range
set rng = cells(activeCell.Row,"E")
do
if rng.Font.ColorIndex = 3 then
rng.EntireRow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
exit do
end if
set rng = rng.offset(1,0)
Loop Until isempty(rng)
msgbox "No row meeting conditions was found"
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp." <Jeff at Robert Bosch
wrote in message
...
Hi,

I am trying to create a macro that will, when a command button is
clicked,
copy a row and format it the same from one sheet to another if the
color
of
the font in one of the cells of that row, let's say column E, is red
or
yellow.

Also, if it doesn't copy one row, I would like it to paste the next
row
fitting the above font color conditions on the line right below in the
new
sheet.

Copy function with using criteria
 

Thanks for your help, I was wondering now if I could paste the rows starting
at row 3 instead of 1 on sheet 2. How would I modify this code. What if I
wanted the code to search for yellow font as well as red? Sorry if these are
very simple request, but I am a new user to macros.

Also, if column d, for example, is blank in any of the rows that it already
is copying, then can it copy the next cell up that has text in it in column d.

Ex. Item Function Action Color
nnn nnn nnn green
nnn
red
nnn
grn
nnn
red
nnn nnn nnn yellow

| |
V

nnn nnn nnn red
nnn
red
nnn nnn nnn
yellow

"Tom Ogilvy" wrote:

There was nothing in your description that would lead me to believe you
wanted to copy all rows in column E that had a red font.

In any event.

Private Sub CommandButton1_Click()
Dim rng as Range, rng1 as Range
Dim cell as Range
set rng = Range(cells(1,"E"),cells(rows.count,"E").End(xlup) )
for each cell in rng
if cell.Font.ColorIndex = 3 then
if rng1 is nothing then
set rng1 = cell
else
set rng1 = union(rng1,cell)
end if
End if
Next cell
if not rng1 is nothing then
rng1.Entirerow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
else
msgbox "No cells met criteria"
End if
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp."
wrote in message
...
I tried this code and it only copied the first cell with red font.. It
didn't copy the cells below it that also had red text. I had text in
E1:E20
and E2, E5, E8, E11, E14, E17, E20 had red text. Does the top cell in
column
E have to be selected before I click the command button?

Thanks,
Jeff Granger

"Tom Ogilvy" wrote:

Private Sub CommandButton1_Click()
Dim rng as Range
set rng = cells(activeCell.Row,"E")
do
if rng.Font.ColorIndex = 3 then
rng.EntireRow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
exit do
end if
set rng = rng.offset(1,0)
Loop Until isempty(rng)
msgbox "No row meeting conditions was found"
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp." <Jeff at Robert Bosch
wrote in message
...
Hi,

I am trying to create a macro that will, when a command button is
clicked,
copy a row and format it the same from one sheet to another if the
color
of
the font in one of the cells of that row, let's say column E, is red
or
yellow.

Also, if it doesn't copy one row, I would like it to paste the next
row
fitting the above font color conditions on the line right below in the
new
sheet.

Copy function with using criteria
 

The code you provided worked in a new worksheet, but when I tried it in the
document I was asked to filter, it only copied rows 71 and 263. Row 71
didn't even have red font in the column and row 263 was not the only row with
red font. Please help me, because I am totally lost.

"Jeff at Robert Bosch Corp." wrote:

Thanks for your help, I was wondering now if I could paste the rows starting
at row 3 instead of 1 on sheet 2. How would I modify this code. What if I
wanted the code to search for yellow font as well as red? Sorry if these are
very simple request, but I am a new user to macros.

Also, if column d, for example, is blank in any of the rows that it already
is copying, then can it copy the next cell up that has text in it in column d.

Ex. Item Function Action Color
nnn nnn nnn green
nnn
red
nnn
grn
nnn
red
nnn nnn nnn yellow

| |
V

nnn nnn nnn red
nnn
red
nnn nnn nnn
yellow

"Tom Ogilvy" wrote:

There was nothing in your description that would lead me to believe you
wanted to copy all rows in column E that had a red font.

In any event.

Private Sub CommandButton1_Click()
Dim rng as Range, rng1 as Range
Dim cell as Range
set rng = Range(cells(1,"E"),cells(rows.count,"E").End(xlup) )
for each cell in rng
if cell.Font.ColorIndex = 3 then
if rng1 is nothing then
set rng1 = cell
else
set rng1 = union(rng1,cell)
end if
End if
Next cell
if not rng1 is nothing then
rng1.Entirerow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
else
msgbox "No cells met criteria"
End if
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp."
wrote in message
...
I tried this code and it only copied the first cell with red font.. It
didn't copy the cells below it that also had red text. I had text in
E1:E20
and E2, E5, E8, E11, E14, E17, E20 had red text. Does the top cell in
column
E have to be selected before I click the command button?

Thanks,
Jeff Granger

"Tom Ogilvy" wrote:

Private Sub CommandButton1_Click()
Dim rng as Range
set rng = cells(activeCell.Row,"E")
do
if rng.Font.ColorIndex = 3 then
rng.EntireRow.copy Destination:= _
Worksheets("Sheet2").Cells(rows.count,1).End(xlup)
exit do
end if
set rng = rng.offset(1,0)
Loop Until isempty(rng)
msgbox "No row meeting conditions was found"
End Sub

--
Regards,
Tom Ogilvy


"Jeff at Robert Bosch Corp." <Jeff at Robert Bosch
wrote in message
...
Hi,

I am trying to create a macro that will, when a command button is
clicked,
copy a row and format it the same from one sheet to another if the
color
of
the font in one of the cells of that row, let's say column E, is red
or
yellow.

Also, if it doesn't copy one row, I would like it to paste the next
row
fitting the above font color conditions on the line right below in the
new
sheet.