VBA Code to Fill Blank Cell with Color based on Another Cell's Contents

[LtCmdrData]

Hello,

I have a column with data and I have the cells highlighted based on the contents using Conditional Formatting. If it says "Frozen" or "Refrigerated" it highlights blue. If it is "Dry" then it highlights green. If it is blank then no highlight. I am trying to write some VBA code to fill the same row cell seven columns to the left with the same blue, green, or no fill. Can anyone help me with this code? Thanks!

 

[Joe4]

Here is code that will run when you press the button. It is assuming column G has the values, column A is what you want to color, and column D can be used to find the last row.
Adjust to suit your needs:

Sub MyColorMacro()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column D with data
    lr = Cells(Rows.Count, "D").End(xlUp).Row

'   Loop through all rows, starting on row 2
    For r = 2 To lr
'       Determine color based on entry in column G
        Select Case Cells(r, "G")
            Case "Frozen", "Refridgerated"
'               Color column A blue
                Cells(r, "A").Interior.Color = vbBlue
            Case "Dry"
'               Color column A green
                Cells(r, "A").Interior.Color = vbGreen
        End Select
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[LtCmdrData]

Column A always has data without any blank cells. Column J has the data with conditionally formatted color that I want to copy just the color into the corresponding row of column C.

 

[Joe4]

Column A always has data without any blank cells. Column J has the data with conditionally formatted color that I want to copy just the color into the corresponding row of column C.

Leaving the Conditional Formatting you currently have in column J, updating my previous code:

Sub MyColorMacro()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Loop through all rows, starting on row 2
    For r = 2 To lr
'       Determine color based on entry in column J
        Select Case Cells(r, "J")
            Case "Frozen", "Refridgerated"
'               Color column C blue
                Cells(r, "C").Interior.Color = vbBlue
            Case "Dry"
'               Color column C green
                Cells(r, "C").Interior.Color = vbGreen
        End Select
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[Joe4]

Here is another option that doesn't rely on you to set the colors in the VBA code, it should copy it from the Conditionally Formatted cells:

Sub MyColorMacro2()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Loop through all rows, starting on row 2
    For r = 2 To lr
'       Copy conditionally formatted color from column J to column C
        Cells(r, "C").Interior.ColorIndex = Cells(r, "J").DisplayFormat.Interior.ColorIndex
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[LtCmdrData]

The first set of code was great. The second set works even better because now the colors exactly match! Thank you so much for your patience and help with this.

 

[Joe4]

You are welcome!

Yes, you could get the first set to match exactly too by figuring out the exact color index you are using for the Conditional Formatting, and hard-coding that into the code. But the second one is dynamic and simply uses the same color, whatever it may be.

 

[LtCmdrData]

I've tried reusing some VBA code for another application but running into a problem. Here is the code:

Sub MyColorMacro2()

Dim lr As Long
Dim r As Long

Application.ScreenUpdating = False

' Find last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row

' Loop through all rows, starting on row 2
For r = 2 To lr
' Copy conditionally formatted color from column J to column C
Cells(r, "C").Interior.ColorIndex = Cells(r, "J").DisplayFormat.Interior.ColorIndex
Next r

Application.ScreenUpdating = True

End Sub

I want to modify the above code so I copy any conditionally formatted color in Columns N, O, and S over to Column B in the same row. I copy this code 3 times and modify each for the 3 different columns and run it. I don't get an error but I don't get the expected results. It only copies the conditional formatting from column S. It is like it is ignoring the first 2 iterations. What can I do to fix this so it will copy from all 3 columns? Thanks.

 

[Joe4]

I want to modify the above code so I copy any conditionally formatted color in Columns N, O, and S over to Column B in the same row. I copy this code 3 times and modify each for the 3 different columns and run it. I don't get an error but I don't get the expected results. It only copies the conditional formatting from column S. It is like it is ignoring the first 2 iterations. What can I do to fix this so it will copy from all 3 columns? Thanks.

I think each copy is copying/overwriting the first one. So you are only left with the last one.

I am not sure that it makes sense to copy over 3 different conditional formats into one single column.
Which one wins in the event that two or more of the columns you are copying from have Conditional Formatting?

 

[LtCmdrData]

Columns N and O are of equal importance with column S being the least important of the three. I was trying to use this as part of a bigger project/problem. See: VBA to Keep Subtotal Groupings Based on Conditional Formatting

 

[Joe4]

Your question is quite a bit different than the original question that was posted 2 years ago, and as such, should have its own thread.
And based on your last post, it looks like you had already posted it in another thread.

Per Forum Rules (#12), you should not post your question to multiple threads. So you should continue on in the original thread you posted. If you do not receive responses to your original thread, you can "bump" it by replying to it yourself. We advise you not to bump a thread more than once a day.