Hi Gav,

What I was saying that the code provided by Patrick would not work, and I
offered a fix to the problem that I saw,. I didn't test the code to see if
it worked completely, just fixed what I knew was wrong.

With my fix it would look like

rw = 10
For Each cell In Range("D9:D98")

If Not IsEmpty(cell) Then

If IsNumeric(cell) Then

if cell.Interior.colorindex = 3 _
AND Cell.Value 1 then

ElseIf cell 0 Then

Sh.Cells(rw, "A").Value = _
Cells(cell.Row, 1).Value
Sh.Cells(rw, "F").Value = Cell.Value
rw = rw + 1
End If
End If
End If
Next


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"gav meredith" wrote in message
...
hi bob, gavin meredith from excel programming on microsoft.com. You
provided some code for me today re alter existing code based upopn a cell
being red. I am having trouble with it??

Do i simply amend the existing code or is this an addition. (sorry, i am a
novice). Will this cancel out the original code because i still need it to
perform the original function. If a user selects 1, the code copies and
pastes to sheet VKnew BUT if the correspoding cell is red then the item
should paste to a different location. basically the same function but a red
cell means the data is to go elsewhere.

Extremely thankful for your help!!!!!

----- Bob Phillips wrote: -----

You can't use ColorIndex with vbRed. ColorIndex is an index between
1-56
referring to the colour palette, vbRed is the RGB value of red. So
you need

if cell.Interior.color = vbRed _

or
if cell.Interior.colorindex = 3 _

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

wrote in message
...
rw = 10
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
if cell.Interior.colorindex = vbRed _
AND Cell.Value 1 then
ElseIf cell 0 Then
Sh.Cells(rw, "A").Value = _
Cells(cell.Row, 1).Value
Sh.Cells(rw, "F").Value = Cell.Value
rw = rw + 1
End If
End If
End If
Next
HTH
Patrick Molloy
Microsoft Excel MVP
-----Original Message-----
hi ,
With a code you provided for me recently, data pasted to
a particular cell
range (sheet called VKnew) if its value was greater than
1. A new criteria
has been added and now i need to have the data paste to
an alternate
location (on VKnew) if a cell in column C is red in
colour AND the data in
columnD is greater than 1. Column C being red simply
ditermines that the
data is of a different nature. Simply, if column D is
greater than 1, the
original below will remain......if column D is greater
than 1 AND column C
is red, the data should paste under a different target
name "optionals". How
on earth would i do this??
Original Code:
Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
Debug.Print Sh.Range("A10").Resize(nrow * 1,
1).EntireRow.Address(external:=True)
' sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
rw = 10
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial
Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, "F").PasteSpecial
Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub
.