• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy row to different sheet if cell is red

F

FranKC

New Member
Hi Guys,

I really hope you can help me ...

I have a workbook with 5 sheets, the first one is an Overview the other 4 hold the information (MOT, TAX, Insurance and Plate).

In short what i really want is, if one cell in the 'MOT' sheet has a conditional formatted cell that is red, then the information in the entire row is moved over to the Overview sheet, but under the MOT heading.

This needs to work for all the four information sheets.

I have uploaded a copy of the workbook so you have an idea of how it has been laid out and hopefully this will give a slightly better understanding of what i would like.

From my limited knowledge of Excel, i think it would work something like this (but way more complicated)

=IF(MOT!D5-D18)=RED(COPY ROW)TO(OVERVIEW!B5)IF(OVERVIEW!B5=FULL)COPY TO(OVERVIEW! B6)

etc

Thanks

Fran
 

Attachments

Last edited:
Hi,

That works (ish), but i would need the information copied and not moved and if possible it would need to keep the coloured backgrounds so i am able to differentiate between the sheets.
 
I modified that background colors, font colors and bold would follow with row information.
Move ... now Copy ... You wrote:
'In short what i really want is, if one cell in the 'MOT' sheet has a conditional formatted cell that is red, then the information in the entire row is moved over to the Overview sheet, but under the MOT heading.
If You want to 'now just copy', how do You mean to avoid duplicates?
Every time then there in this months date, that row would copy to in the end of 'OverView'-sheet.
There would be soon many duplicates... or
did You also want to avoid duplicates or no matter?
It's still moves ...
 

Attachments

I looked at your conditional formatting & saw that it colours date in current month red, so accordingly I've created the macro to check cell date month = current month & then copy & paste in overview. Assuming that the format of Overview sheet is the same as MOT sheet i.e. columns are in same place. It should work.

Note that this is just a simple copy paste macro. It does not check for duplicates. If you run it more than once within the same month then you'll have to clear off the old data from overview sheet for that month.

Code: 
Sub RedMove()

Worksheets("MOT").Select
Range("D5").Select
Do Until IsEmpty(Range("B" & ActiveCell.Row))
    If Format(ActiveCell, "mmm") = Format(Date, "mmm") Then
        Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy
        Worksheets("Overview").Select
        Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Worksheets("MOT").Select
    Else
    End If
        ActiveCell.Offset(1, 0).Select
Loop
End Sub
 
Ohhh that is awesome!! Exactly what i wanted!

Is there a simple way to add deletion of duplicates?? It's not a major thing as it should only be run on the 1st of every month.

Thank You!

chirayu said:
I looked at your conditional formatting & saw that it colours date in current month red, so accordingly I've created the macro to check cell date month = current month & then copy & paste in overview. Assuming that the format of Overview sheet is the same as MOT sheet i.e. columns are in same place. It should work.

Note that this is just a simple copy paste macro. It does not check for duplicates. If you run it more than once within the same month then you'll have to clear off the old data from overview sheet for that month.

Code: 
Sub RedMove()

Worksheets("MOT").Select
Range("D5").Select
Do Until IsEmpty(Range("B" & ActiveCell.Row))
    If Format(ActiveCell, "mmm") = Format(Date, "mmm") Then
        Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy
        Worksheets("Overview").Select
        Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Worksheets("MOT").Select
    Else
    End If
        ActiveCell.Offset(1, 0).Select
Loop
End Sub
Click to expand...
 
Added Removeduplicates & a messagebox so you know when it finishes

Code: 
Sub RedMove()

Dim LstRow As Integer

Worksheets("MOT").Select
Range("D5").Select
Do Until IsEmpty(Range("B" & ActiveCell.Row))
    If Format(ActiveCell, "mmm") = Format(Date, "mmm") Then
        Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy
        Worksheets("Overview").Select
        Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Worksheets("MOT").Select
    Else
    End If
        ActiveCell.Offset(1, 0).Select
Loop

Worksheets("Overview").Select
LstRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("B5:E" & LstRow).RemoveDuplicates Array(1, 2, 3, 4), xlNo
Range("A1").Select

MsgBox "Macro completed", vbInformation, ""

End Sub
 
Awesome. Is it just a case now of copying

Worksheets("MOT").Select
Range("D5").Select
DoUntil IsEmpty(Range("B" & ActiveCell.Row))
If Format(ActiveCell, "mmm") = Format(Date, "mmm") Then
Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy
Worksheets("Overview").Select
Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("MOT").Select

Else
EndIf
ActiveCell.Offset(1, 0).Select
Loop

And changing the "MOT" field to "TAX" etc so it covers the entire workbook??

Thanks
 
Basically yeah. But if you have like a load of sheets then you might wanna go down the route of something like below

Code: 
Sub RedMove()

Dim ws As Worksheet
Dim LstRow As Integer
Dim Sht As String

For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "Overview" Then
       
        ws.Select
        Sht = ActiveSheet.Name
        Range("D5").Select
        Do Until IsEmpty(Range("B" & ActiveCell.Row))
            If Format(ActiveCell, "mmm") = Format(Date, "mmm") Then
                Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy
                Worksheets("Overview").Select
                Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                Worksheets(Sht).Select
            Else
            End If
                ActiveCell.Offset(1, 0).Select
        Loop
       
    Else
    End If

Next

Worksheets("Overview").Select
LstRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("B5:E" & LstRow).RemoveDuplicates Array(1, 2, 3, 4), xlNo
Range("A1").Select

MsgBox "Macro completed", vbInformation, ""

End Sub
 
Hi !

To directly copy unique data, don't forget the advanced filter …

See the tutorials of this site
as well the samples of appropriate VBA Macros forum !
​
 
Absolutely perfect! I've finally got all the data entered, run the macro and it is perfect. It's pulled data perfectly from the sheets.

Brilliant! Thank you so much!! (i still have no idea how it all works, but i'm really glad it did! Thank you!)


chirayu said:
Basically yeah. But if you have like a load of sheets then you might wanna go down the route of something like below

Code: 
Sub RedMove()

Dim ws As Worksheet
Dim LstRow As Integer
Dim Sht As String

For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "Overview" Then
      
        ws.Select
        Sht = ActiveSheet.Name
        Range("D5").Select
        Do Until IsEmpty(Range("B" & ActiveCell.Row))
            If Format(ActiveCell, "mmm") = Format(Date, "mmm") Then
                Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy
                Worksheets("Overview").Select
                Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                Worksheets(Sht).Select
            Else
            End If
                ActiveCell.Offset(1, 0).Select
        Loop
      
    Else
    End If

Next

Worksheets("Overview").Select
LstRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("B5:E" & LstRow).RemoveDuplicates Array(1, 2, 3, 4), xlNo
Range("A1").Select

MsgBox "Macro completed", vbInformation, ""

End Sub
Click to expand...
 
Thanks for that,

I have however, this morning, come across a small issue. I have updated one of the dates that was red, re-run the macro and it has pulled the information across even though the cell is not red.

Any ideas what i might have done wrong?
 
Can you post the sample data so I can run the code to see what's up. more than likely its probably the date in the cell itself that has the month as July. As the code checks if cell month = current month. Is the year a different year or same year? as there aren't any year checks in the macro
 
Thanks for all your help.

Here is a copy of the document i'm using that is entirely accurate as of this moment!

Hope it clears things up.
 

Attachments

Its as I suspected. You had July 2017 dates in your file & the macro was made to only check month, not year so I've added in the bit of code that'll check current year too.
 

Attachments

Hi,

It still doesnt appear to be working correctly on mine. When i run the macro it leaves the 'red row' in the overview page AND still pulls in the row that is now not red.

Am i just making things really complicated??

After all the updates i've done today, i should only have 2 'red' rows in overview ... i still have 4 red rows and an additional non red row.
 
I'm guessing its probably because the macro copies the red rows then removes duplicates. It doesn't clear "Overview" sheet before copying. So any changes you make to existing rows in other sheets wouldn't reflect in "Overview". I think the best option then is for me to add in a bit of code that'll clear out the "Overview" sheet so that its blank & then do the copy & remove duplicates.
 

Attachments

You must log in or register to reply here.
Back
Top