Alter existing code
 

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

Alter existing code
 

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


.

Alter existing code
 

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


.

Alter existing code
 

hi 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!!!!

----- wrote: ----

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

If Not IsEmpty(cell) The

If IsNumeric(cell) The

if cell.Interior.colorindex = vbRed
AND Cell.Value 1 the

ElseIf cell 0 The

Sh.Cells(rw, "A").Value =
Cells(cell.Row, 1).Valu
Sh.Cells(rw, "F").Value = Cell.Valu
rw = rw +
End I
End I
End I
Nex


HT
Patrick Mollo
Microsoft Excel MV

-----Original Message----
hi
With a code you provided for me recently, data pasted to
a particular cel
range (sheet called VKnew) if its value was greater than
1. A new criteri
has been added and now i need to have the data paste to
an alternat
location (on VKnew) if a cell in column C is red in
colour AND the data i
columnD is greater than 1. Column C being red simply
ditermines that th
data is of a different nature. Simply, if column D is
greater than 1, th
original below will remain......if column D is greater
than 1 AND column
is red, the data should paste under a different target
name "optionals". Ho
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 Rang
Dim nrow As Long, rw As Lon
Dim Sh As Workshee
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.Inser
rw = 1
For Each cell In Range("D9:D98"
If Not IsEmpty(cell) The
If IsNumeric(cell) The
If cell 0 The
Cells(cell.Row, 1).Cop
Sh.Cells(rw, "A").PasteSpecial
Paste:=xlPasteValue
Cells(cell.Row, 4).Cop
Sh.Cells(rw, "F").PasteSpecial
Paste:=xlPasteValue
rw = rw +
End I
End I
End I
Nex
End Su

Alter existing code
 

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-5
referring to the colour palette, vbRed is the RGB value of red. So you nee

if cell.Interior.color = vbRed

o
if cell.Interior.colorindex = 3

--

HT

Bob Phillip
... looking out across Poole Harbour to the Purbeck
(remove nothere from the email address if mailing direct

wrote in messag
..
rw = 1
For Each cell In Range("D9:D98"
If Not IsEmpty(cell) The
If IsNumeric(cell) The
if cell.Interior.colorindex = vbRed
AND Cell.Value 1 the
ElseIf cell 0 The
Sh.Cells(rw, "A").Value =
Cells(cell.Row, 1).Valu
Sh.Cells(rw, "F").Value = Cell.Valu
rw = rw +
End I
End I
End I
Nex
HT
Patrick Mollo
Microsoft Excel MV
-----Original Message----
hi
With a code you provided for me recently, data pasted t
a particular cel
range (sheet called VKnew) if its value was greater tha
1. A new criteri
has been added and now i need to have the data paste t
an alternat
location (on VKnew) if a cell in column C is red i
colour AND the data i
columnD is greater than 1. Column C being red simpl
ditermines that th
data is of a different nature. Simply, if column D i
greater than 1, th
original below will remain......if column D is greate
than 1 AND column
is red, the data should paste under a different targe
name "optionals". Ho
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 Rang
Dim nrow As Long, rw As Lon
Dim Sh As Workshee
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.Inser
rw = 1
For Each cell In Range("D9:D98"
If Not IsEmpty(cell) The
If IsNumeric(cell) The
If cell 0 The
Cells(cell.Row, 1).Cop
Sh.Cells(rw, "A").PasteSpecia
Paste:=xlPasteValue
Cells(cell.Row, 4).Cop
Sh.Cells(rw, "F").PasteSpecia
Paste:=xlPasteValue
rw = rw +
End I
End I
End I
Nex
End Su

Alter existing code
 

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
.