If row is green copy all date to another row

[Adam_98]

I'm quite new to Excel and I'm trying to create a document to help me for work. I have a main sheet where all my data is inputted into. The rows in this data will be Green, Amber or red depending on the status. What my goal is, when a row is green, it copies the data from one sheet to another. Is there any way to do this and is any further information needed?

 

[Adam_98]

Hello Adam,

Just my two cents worth. Try the following trimmed down code assigned to the short cut key mentioned in an earlier post:-

Option Explicit
Sub Test()

        Dim wsQ As Worksheet: Set wsQ = Sheets("quotes")
        Dim wsSD As Worksheet: Set wsSD = Sheets("Spread Data")

Application.ScreenUpdating = True

        With wsQ.Range("A4", wsQ.Range("A" & wsQ.Rows.Count).End(xlUp))
                .AutoFilter 1, RGB(0, 176, 80), 8
                .Offset(1).Resize(, 27).Copy wsSD.Range("A" & Rows.Count).End(3)(2)
                '.Offset(1).Resize(, 27).EntireRow.Delete
                .AutoFilter
        End With

Application.ScreenUpdating = True

End Sub

Take heed of Joe's last post and the above should work for you.
The code also has a delete line of code included in case you want to delete the relevant rows from the 'quotes' sheet once a data transfer has been completed. It's in green font. To active this line of code, just remove the apostrophe from in front of it.

I hope that this helps.

Cheerio,
vcoolio.

Hey Vcoolio,


Thanks for chipping in with this trimmed code, it's appreciated.
I've did a bit of testing around the usability on the specific purpose on the workbook. I don't want to delete the existing information as I can use the data however when I add new information and run the Macro it duplicates the data that has already been copied over. Is there a way to stop this?

Thanks Again,

Adam

 

[Joe4]

Thanks for reviewing and spotting the Error. It's working now. Just new into coding but didn't even think something that small would impact the code so much.

You will find in programming, the small details are extremely important.
Anytime you are making a reference or doing any sort of matching, you need to match exactly (except for in cases in which you are intentionally doing an approximate or partial match).

 

[Adam_98]

You will find in programming, the small details are extremely important.
Anytime you are making a reference or doing any sort of matching, you need to match exactly (except for in cases in which you are intentionally doing an approximate or partial match).

Appreciate this information and I will 100% take it on Board

 

[vcoolio]

Hello Adam,

however when I add new information and run the Macro it duplicates the data that has already been copied over. Is there a way to stop this?

Hence, the delete line of code. However, if you really need to keep all the data in the source sheet, then refreshing the destination sheet would be your best option.

Place this line of code:

wsSD.UsedRange.Offset(1).Clear

directly after:

Application.ScreenUpdating = True

This clears the destination sheet prior to any data transfer from the source sheet meaning that you will always have both old and new data added to the destination sheet without duplication each time the code is run.

You can leave the delete line of code in place as long as you leave the apostrophe in front of it. This will keep the line of code inactive.

I hope that this helps.

Cheerio,
vcoolio.

 

[Adam_98]

Hello Adam,



Hence, the delete line of code. However, if you really need to keep all the data in the source sheet, then refreshing the destination sheet would be your best option.

Place this line of code:

wsSD.UsedRange.Offset(1).Clear

directly after:

Application.ScreenUpdating = True

This clears the destination sheet prior to any data transfer from the source sheet meaning that you will always have both old and new data added to the destination sheet without duplication each time the code is run.

You can leave the delete line of code in place as long as you leave the apostrophe in front of it. This will keep the line of code inactive.

I hope that this helps.

Cheerio,
vcoolio.

Thank you !! All working how I want it to work.

 

[vcoolio]

You're welcome Adam. I'm glad that we were all able to chip in and help.

Cheerio,
vcoolio.

 

[Adam_98]

Hello Again,

So, I've made a new sheet with the data I need and I've tried to tweak the existing code with no luck unfortunatly. It's not taking the data from the additional fields that I've added in and pasting them onto spread Data.
I've attached the VBA and the spreadsheet

Run 1 Profit & Loss (1) (version 2).xlsb

1drv.ms

Option Explicit
Sub Filter_Green()

        Dim wsQ As Worksheet: Set wsQ = Sheets("Master")
        Dim wsSD As Worksheet: Set wsSD = Sheets("Spread Data")

Application.ScreenUpdating = True
wsSD.UsedRange.Offset(1).Clear

        With wsQ.Range("A9", wsQ.Range("A" & wsQ.Rows.Count).End(xlUp))
                .AutoFilter 1, RGB(0, 176, 80), 8
                .Offset(1).Resize(, 27).Copy wsSD.Range("A" & Rows.Count).End(3)(2)
                '.Offset(1).Resize(, 27).EntireRow.Delete
                .AutoFilter
        End With

Application.ScreenUpdating = True


End Sub

 

[vcoolio]

Hello Adam,

I can't open your attachment but if you just require additional columns to be added then alter the 27 in this line:-

.Offset(1).Resize(, 27).Copy wsSD.Range("A" & Rows.Count).End(3)(2)

to the number of columns required (the 27 takes you out to Column AA) so if its to be out to Column AB then change it to 28.

Adam,
Also, if you've changed the headings row, alter the A9 in this line of code:-

With wsQ.Range("A9", wsQ.Range("A" & wsQ.Rows.Count).End(xlUp))

to whichever row the headings are now in (A8, A10??).

Cheerio,
vcoolio.

 

[Adam_98]

I was looking for a value of AA but it all makes sense now. I've ran the Macro and it gets rid of all my formula and conditional formatting. Is there a way to stop this from happening so the formulas are carried onto "spread data"?

 

[vcoolio]

If you want to carry over the formatting and formulae:

Change this line:-

.Offset(1).Resize(, 27).Copy wsSD.Range("A" & Rows.Count).End(3)(2)

to these two lines:-

.Offset(1).Resize(, 27).Copy
wsSD.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll

and add this line:-

Application.CutCopyMode = False

directly above

Application.ScreenUpdating = True

Cheerio,
vcoolio.