Macro code to copy cell color to another cell if condition is met

[hamkham93]

Hi. I'm new to VBA and I'm need help to create a code for tracking a recurring task on a schedule at different frequencies.

1- I used Excel formula to generate a color value for the colors I am using.
2- Using row 5 as an example.

• If row 5 (Area1) contains the color value "42" (blue) it should copy the cell same color, move it 31 cells to the right and paste blue color (which should be cell AG5 - I copied it manually for the example)
• I would like to the code to do this for any of the 4 colors listed for rows 5 to 9

Thank you in advance!

 

[Micron]

Well, what I have so far was written on the understanding that each of the five rows would have a specific colour somewhere. Not necessarily 5 different colours, but you would not be putting a blue in row 5 one time, and maybe next time in that row it would be yellow. If that's what you're doing, what I have won't work.

I think you're incorrect regarding what I said about H6 because you don't know about the difference between UsedRange vs the last cell in a range that has data. They are not the same thing. I was only complaining about (AFAIK) the impossibility of finding the UsedRange for a particular row. It is based on all rows. It should not be a problem, I think.

I'm basing my code on this:
- row 5 uses blue and blue only, 6 uses only yellow, 8 uses only orange, brown I still don't know where after 10 posts
- code finds last cell in a row that uses its specific row colour and based on a number for that colour, offsets and shades a cell that far to the right
- it does that each time for ALL rows which I now suspect that is not what you want.

I only wish you could nail down what happens and where, because now that image shows yellow in row 5 but you 1st post shows it was using blue.
IMO, maintenance tracking is a job for a database, but that's another can of worms I guess.

 

[hamkham93]

Based on your code bullet points, that's a good starting point. I would appreciate it if you post the code. I will start with it and see how I can change it after I do some research (maybe change the idea of my sheet to run based on your code).

Yes, maintenance tracking is a database, I am doing all this for a temporary solution till I get some database that can do this automatically. thank you

 

[shinigamilight]

Try this

Sub wrw()
        Dim our, k, i As Long
        Dim lr As Long: lr = Range("A" & Rows.Count).End(xlUp).Row
        Dim lc As Long: lc = Cells.Find("*", Cells(1, 1), , , xlByColumns, xlPrevious).Column
        
        
        For k = 5 To lr
            For i = 2 To lc
                    our = Cells(k, i).Interior.ColorIndex
                    Select Case our
                    Case 40: Cells(k, i).Offset(0, 90).Interior.ColorIndex = 40: GoTo work
                    Case 42: Cells(k, i).Offset(0, 30).Interior.ColorIndex = 42: GoTo work
                    Case 6: Cells(k, i).Offset(0, 7).Interior.ColorIndex = 6: GoTo work
                    Case 44: Cells(k, i).Offset(0, 14).Interior.ColorIndex = 44: GoTo work
                    End Select
            Next i
work:
        Next k
        
End Sub

 

[Micron]

Based on your code bullet points, that's a good starting point. I would appreciate it if you post the code. I will start with it and see how I can change it after I do some research (maybe change the idea of my sheet to run based on your code).

Colour numbers are what I got from what I used.

Sub FindCellWithAcolour()
Dim rng As Range
Dim Lcol As Long, i As Integer, x As Integer

Lcol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.count).Column

For i = 5 To 9
    x = Lcol
    Do Until x < 2
        Select Case Cells(i, x).Interior.Color
            Case 14395790
                 Cells(i, x).Offset(0, 31).Interior.Color = 14395790
                 x = 2
            Case 65535
                 Cells(i, x).Offset(0, 7).Interior.Color = 65535
                 x = 2
            Case 24704
                 Cells(i, x).Offset(0, 9).Interior.Color = 24704 'make brown 90, not 9
                 x = 2
            Case 49407
                 Cells(i, x).Offset(0, 14).Interior.Color = 49407
                 x = 2
            End Select
         x = x - 1
     Loop
Next

End Sub

 

[hamkham93]

Thank you so much! I will give it a try