PDA

View Full Version : Copy Colours



adamsm
04-11-2010, 04:36 AM
Hi friends,
I’m new to Excel macros and VB coding.
I’m trying to create a Workbook for my color paints. I have included two sheets in my workbook which I want the following to happen with the help of a VB code.
When I write either “blue” or “red” in the sheet named “colour”; I want the rows light blue & dark blue get copied from the sheet “ColourTypes” into the row, below where I write the text blue. I want them to be copied to the column “A” of the sheet “colour” from the sheet “ColourTypes”.
Moreover, when I write the age in the cell ‘F1” of the “colour” sheet I want the row that contains a lue between the age range to be copied into the sheet “colour”
I did try using Vlook up formulas but that didn’t suit my need. So I thought for a second choice.
Let’s say for example I write blue in the sheet “colour” and in the cell F1 of the same sheet I write 16, I want the rows light blue & dark blue that contains the range between 16 to get copied, meaning I want the rows 8 and 10 to get copied under the row blue of the sheet “colour”
I hope I have made my question clear.
Any help would be kindly appreciated.

lucas
04-11-2010, 01:11 PM
It's not really clear whether you intend to expand on this or not so I just did the color blue for you and the ages 17 & 18

This is sheet change code. It goes in the module for the sheet.

type blue in column A and make sure F1 has either a 17 or 18

Option Explicit
Option Compare Text
Private Sub worksheet_change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
If target.Column = 1 And target.Row <> 1 Then
If target.Value = "Blue" And (Range("F1").Value = "17" Or Range("F1").Value = "18") Then
Sheets("ColourTypes").Rows("8:8").Copy
target.Offset(1, 0).PasteSpecial
Sheets("ColourTypes").Rows("10:10").Copy
target.Offset(2, 0).PasteSpecial
Application.CutCopyMode = False
End If
End If
End Sub

If this looks like it will work for you then maybe you can extend what I have here to cover your other needs.

mdmackillop
04-11-2010, 01:18 PM
Code can be triggered by an event such as Button click, by entering a value in Column 1, or by changing cell F1. It is easier to code if we know what you're really after. Your date values don't make much sense. Can you provide more realistic data.

Cyberdude
04-11-2010, 04:56 PM
The problem is that you don't know how to spell "color" :devil2: (chuckle)

As an aside, let me warn you that if you aren't using Excel 2007, then understand that there are new "colour" rules in the new Excel. If you expect to switch over in the near future make sure your solution takes that into account.
Sid

adamsm
04-12-2010, 11:08 AM
First of all I would like to thank all of you friends for replying to my post. I do really appreciate the code that you had provided me. If I may ask more how could the code be modified, if I write the any age within the range so that the appropriate reference range is copied?

Say for example, if I write 35 as age in the cell F1, how could I modify the following code; same as IF I write any date between the ranges 30 to 40.

If target.Count > 1 Then Exit Sub
If target.Column = 1 And target.Row <> 1 Then
If target.Value = "Yellow" And (Range("F1").Value = "30" Or Range("F1").Value = "40") Then
Sheets("ColourTypes").Rows("14:14").Copy
target.Offset(1, 0).PasteSpecial
Sheets("ColourTypes").Rows("16:16").Copy
target.Offset(2, 0).PasteSpecial
Application.CutCopyMode = False

Thanks in advance.

mdmackillop
04-13-2010, 11:12 AM
For the following code to work, you MUST have a space separating the numbers from "-" and Months/Years

17 - 18 months


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, cel As Range
Dim Age As Long, L As Long, H As Long, X As Long

If Target.Count > 1 Then Exit Sub
On Error GoTo Exits

Age = Range("F1")
If Target.Column = 1 And Target.Row <> 1 Then

Application.EnableEvents = False
With Sheets("ColourTypes")
Set c = .Columns(1).Find(Target).Offset(1).Resize(4)
For Each cel In c.Offset(, 4)
L = Split(cel)(0)
H = Split(cel)(2)
If Age >= L And Age <= H Then
X = X + 1
cel.Offset(, -4).Resize(, 5).Copy Target(X + 1)
End If
Next
End With
End If

Exits:
Application.EnableEvents = True
End Sub

adamsm
04-13-2010, 11:39 AM
Thanks mdmackillop. Your version of the code works the way I want it to be working. May God bless you. I have modified the code according to my need now.

Once again Thanks to all of the friends who had replied & help me. I do really appreciate the code from lucas too

adamsm
04-13-2010, 12:48 PM
One more help if I may ask. I have added two worksheets to my workbook with the name of "Orders" & "Database"


I’m having four columns in my worksheet "Orders" where my data starts from the 8th row.

I have written a macro code to the workbook where I’m trying to copy data from the columns A, B, C, & D of the worksheet “Orders” to the columns G, H, I & J of the sheet “Database”.

In the column A I have the text “Product Colours” which I don’t want to get copied into column “H” also in column “B” I have the text “Status” which I don’t want to get copied into the Column “H”. And in column “C” I have “Capacity” which I don’t want to get copied into column “I” And in column “D”, I have the text “Range” which I don’t want to get copied into the column “J” of the worksheet “Database”

I have column headers repeated which I don't want them to appear in the copied columns of the worksheet "Database".

For example if the save button is clicked the data that is copied from the column A of the worksheet "Orders" I don't want the "Product “Colors” to appear has product name gets doubled.

Instead I want it to be omitted when the column is copied.

When the columns are copied; the bar below the excel application asks me to press enter to paste the data that has been selected or copied. How this could be prevented.

In short, I don't want the text that is in bold to be copied to the sheet "Database" Also I don't want empty rows when the data is copied.

I have attached my code & workbook for your reference.


Note: I have deleted the previous worksheets form my workbook for easy reference.

Any help would be kindly appreciated.

Thanks in advance.