Copy Cells to another sheet based on fill colour

[pwilson06]

HI,
I have a page set up that has a macro to fill the cell yellow(Interior.ColorIndex = 6) when the value changes. I use this page to do price changes for products that we sell, which is a catalouge of over 600 products.
Is there a way (VBA??) I can use to have the highlighted cells copied to another sheet to show a customer just the items/prices that have changed rather than sending them a product list with all 600+ products.
Some of the cells that need to be copied have formulas in them but I only need to paste the values.
Thanks

 

[My Aswer Is This]

HI,
I have a page set up that has a macro to fill the cell yellow(Interior.ColorIndex = 6) when the value changes. I use this page to do price changes for products that we sell, which is a catalouge of over 600 products.
Is there a way (VBA??) I can use to have the highlighted cells copied to another sheet to show a customer just the items/prices that have changed rather than sending them a product list with all 600+ products.
Some of the cells that need to be copied have formulas in them but I only need to paste the values.
Thanks

Sure this can be done. If you provide some specific details I may be able to provide you a script to do what you want.
Is there some reason you want to use the script you already have and then use a different script to copy the values to another sheet?

Why not write one script that when you change a value to copy that value to another sheet.
So please provide specific details like where on what sheet do you plan to change values and to what sheet and where on the sheet do you want these values copied.

For example on sheet named "Master" I plan to change values in column A and when I make the change copy the values in Column A to E to sheet named "Update" column A to E.

 

[Trebor76]

Hi pwilson06,

Welcome to MrExcel!!

See how this goes:

Option Explicit
Sub Macro1()

    Dim lngMyRow As Long
    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim wsSource As Worksheet
    Dim wsDestin As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSource = ThisWorkbook.Sheets("Sheet1") 'Sheet name with data to be copied. Change to suit.
    Set wsDestin = ThisWorkbook.Sheets("Sheet2") 'Sheet name with data to be pasted. Change to suit.
    
    'The following assumes columns A to C of 'wsSource' are to be copied to 'wsDestin'
    'if the value in Col. C of 'wsSource' is filled with yellow.  Change to suit.
    'Note the code also assumes there is some data on both sheet.  If there's not it will error out.
    lngLastRow = wsSource.Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For lngMyRow = 2 To lngLastRow
        If wsSource.Range("C" & lngMyRow).Interior.Color = RGB(255, 255, 0) Then
            lngPasteRow = wsDestin.Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsDestin.Range("A" & lngPasteRow & ":C" & lngPasteRow).Value = wsSource.Range("A" & lngMyRow & ":C" & lngMyRow).Value
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[pwilson06]

Sure this can be done. If you provide some specific details I may be able to provide you a script to do what you want.
Is there some reason you want to use the script you already have and then use a different script to copy the values to another sheet?

Why not write one script that when you change a value to copy that value to another sheet.
So please provide specific details like where on what sheet do you plan to change values and to what sheet and where on the sheet do you want these values copied.

For example on sheet named "Master" I plan to change values in column A and when I make the change copy the values in Column A to E to sheet named "Update" column A to E.

Thanks for the Reply.
I am pretty new to VBA's and certainly not set on having them separate, having it all as one sounds good to me.
From my sheet called 'Changes' i would like to copy product details and price so i need to copy data from columns C, D and O. This data sits between C4:O799. The changes need to go to worksheet 'Rayners Price Changes' starting from row 3. Column C from worksheet 'Changes' needs to go to column A, then D to B and O to C.
The current macro is set up to highlight any cell yellow if it changes on worksheet'Changes' See Below:
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Interior.ColorIndex = 6
End Sub

Hopefully this is enough detail, thanks so much for your help.

 

[Trebor76]

Try this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lngPasteRow As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Target.Interior.ColorIndex = 6
    
    On Error Resume Next
        lngPasteRow = Sheets("Rayners Price Changes").Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        If lngPasteRow = 0 Then
            lngPasteRow = 3
        Else
            lngPasteRow = lngPasteRow + 1
        End If
    On Error Resume Next
    
    Sheets("Rayners Price Changes").Range("A" & lngPasteRow).Value = Range("C" & Target.Row).Value
    Sheets("Rayners Price Changes").Range("B" & lngPasteRow).Value = Range("D" & Target.Row).Value
    Sheets("Rayners Price Changes").Range("C" & lngPasteRow).Value = Range("O" & Target.Row).Value
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub

 

[pwilson06]

Hi,
This worked really well but i need to change it, i probably didn't think it through well enough. I only want the items to go into the 'Rayners Price Changes' sheet if the price in column O changes.
Thanks

 

[Trebor76]

Try this event macro on the Changes tab:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lngPasteRow As Long
    
    If Target.Column = 15 And Target.Row >= 4 Then 'Only works on range O4:O [whatever row]
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        Target.Interior.ColorIndex = 6
        
        On Error Resume Next
            lngPasteRow = Sheets("Rayners Price Changes").Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lngPasteRow = 0 Then
                lngPasteRow = 3
            Else
                lngPasteRow = lngPasteRow + 1
            End If
        On Error Resume Next
        
        Sheets("Rayners Price Changes").Range("A" & lngPasteRow).Value = Range("C" & Target.Row).Value
        Sheets("Rayners Price Changes").Range("B" & lngPasteRow).Value = Range("D" & Target.Row).Value
        Sheets("Rayners Price Changes").Range("C" & lngPasteRow).Value = Range("O" & Target.Row).Value
        
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        
    End If
    
End Sub

 

[pwilson06]

That works perfect! Thanks so much for your help.

 

[Trebor76]

Thanks for letting us know and you're welcome

 

[pwilson06]

HI,
I've just found something i need to change that i didn't pick up when testing. I tried to adapt the VBA but couldn't get it to work.
In worksheet 'Changes' I need any cell that changes value to be highlighted yellow between C4:P799, but only paste as above.
Thanks again for your help on this