Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Alter existing code
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 54
Default 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


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
No Name
 
Posts: n/a
Default 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


.

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default 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


.



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 14
Default 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


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default 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
.



Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 14
Default 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


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
alter code to apply to range (links cells w/ row insertions) purplec0ws Excel Discussion (Misc queries) 1 November 10th 09 10:19 AM
Really need help with existing code. Cam Excel Discussion (Misc queries) 0 August 12th 08 07:14 PM
Alter pivot with code Steve Excel Discussion (Misc queries) 0 November 7th 07 09:23 PM
Help with existing code ploddinggaltn Excel Discussion (Misc queries) 1 November 27th 06 09:46 PM
Help in Modification of existing code JMay Excel Programming 11 February 28th 04 08:11 PM


All times are GMT +1. The time now is 04:59 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement