简体   繁体   中英

value from a range in .interior.color \ VBA EXCEL 2013

I have in column F numbers , each number refers to a color code, I'm trying to auto change each cell color in F based on its value , BUT ALL COMES ONLY IN BLACK , below is my code :

Sub Highlight()

 For Each C In Worksheets("Sheet3").Range("F3:F1000")


With Sheet3.Range("$F1:$F1000")
    .FormatConditions.Delete

    With .FormatConditions.Add(Type:=xlExpression, Formula1:="=($F1<>"""")")
        .Interior.Color = C.Value
        .Font.Color = vbWhite
 End With

 End With
 Next C

End Sub

Help please & thank you in advance.

As you've already got a loop to repeat over the cells in F3:F1000, it would be enough to use that. The main thing is changing .Interior.Color to .Interior.ColorIndex

Sub Highlight()

For Each C In Worksheets("Sheet3").Range("F3:F1000")

If (C <> "") Then
    C.Interior.ColorIndex = C.Value
    C.Font.Color = vbWhite
End If

Next C
End Sub

The only issue is that if any of the numbers in your cells were greater than 56, you would get a subscript error in the ColorIndex values. You could make it recycle the colours by putting

c.Interior.ColorIndex = (c.Value - 1) Mod 56 + 1

I would split your code to 2 Sub s:

  1. Sub CondFormat - to apply conditional formatting (once).
  2. Sub Highlight - to apply cell color based on it's value - more frequently.

Code

Option Explicit

Dim LastRow As Long

Sub CondFormat()

With Worksheets("Sheet3")
    LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row

    With .Range("F1:F" & LastRow)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=($F1<>" & Chr(34) & Chr(34) & ")"
    End With

End With

End Sub


Sub Highlight()

Dim Rng As Range

With Worksheets("Sheet3")
    LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
    For Each Rng In .Range("F3:F" & LastRow)
        Rng.Interior.Color = Rng.Value
        Rng.Font.Color = vbWhite
    Next Rng
End With

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM