How can I use VBA to Format a cell if it contains some value with a length greater than 1?
(This rule should ofc apply to all cells in the range)
Set text_value = Range("$A:$A").FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=--LEN($A1)>1")
With text_value
.Interior.Color = vbRed
.Borders.LineStyle = xlContinuous
End With
This is what I have tried, but does not work!
Change Type to xlExpression, because you are using formula as a criteria and it will work.
Set text_value = Range("$A:$A").FormatConditions.Add(Type:=xlExpression, Operator:=xlEqual, Formula1:="=LEN($A1)>1")
With text_value
.Interior.Color = vbRed
.Borders.LineStyle = xlContinuous
End With
Related
Hi, every day i have to update an excel file. This includes formatting column B. (see picture above). I haven't found VBA code yet, to geht this kind of formatting via VBA. in the picture you see a subset of formatting rules, there are more. But there is only those three colors, which I have the hex code.
yellow
#9C5700
red
#9C0006
green
#006100
' (1) Highlight defined good as green values
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "=2")
.Interior.ColorIndex = 6
.StopIfTrue = False
End With
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "in Anfrage")
.Interior.ColorIndex = 6
.StopIfTrue = False
End With
' (2) Highlight defined ok as yellow values
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "=1")
.Interior.ColorIndex = 4
.StopIfTrue = False
End With
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "ok")
.Interior.ColorIndex = 4
.StopIfTrue = False
End With
' (2) Highlight defined bad as red values
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "=3")
.Interior.ColorIndex = 3
.StopIfTrue = False
End With
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "kritisch")
.Interior.ColorIndex = 3
.StopIfTrue = False
End With
End Sub
I used this code, but i would like to use the hex colors. How do I use those?
Per this Article:
You can assign the color codes to any Color property of any object in either their decimal or hex representation. Precede the Hex value with the &H prefix
However for some reason VBA does swap the first two characters with the last two characters of a hex code, so your Yellow 9C7500 would go into VBA as 00759C
So, instead of .Interior.ColorIndex, use .Interior.Color and put in your hex codes with &H at the start.
Example:
' (1) Highlight defined good as green values
With Range("b:b").FormatConditions.Add(xlCellValue, xlEqual, "=2")
.Interior.Color = &H006100
.StopIfTrue = False
End With
You can use .Color instead of .ColorIndex and you can also use RGB() to more easily set the value
so change your code to
.Interior.Color = RGB(&H9C,&H57,&H00)
Please, try the next code. Formatting the whole column will consume a lot of Excel resources, slows down the process of formulas update and it useless. The above code format only the B:B column having data:
Sub SetFormatRngMultiple_Cond()
Dim ws As Worksheet, lastR As Long, rngF As Range
Set ws = ActiveSheet
lastR = ws.Range("B" & ws.rows.count).End(xlUp).row
Set rngF = ws.Range("B2:B" & lastR)
With rngF
'first condition:
With .FormatConditions
.Delete
.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=2"
End With
With .FormatConditions(.FormatConditions.count)
.Font.Color = 1137094
.Interior.Color = vbYellow
.SetFirstPriority: .StopIfTrue = False
End With
'second condition:
With .FormatConditions
.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=1"
End With
With .FormatConditions(.FormatConditions.count)
.Font.Color = 5287936
.Interior.Color = 11854022
.StopIfTrue = False
End With
'third condition:
With .FormatConditions
.Add Type:=xlTextString, String:="OK", TextOperator:=xlContains
End With
With .FormatConditions(.FormatConditions.count)
.Font.Color = 5287936
.Interior.Color = 11854022
.StopIfTrue = False
End With
'fourth condition:
With .FormatConditions
.Add Type:=xlTextString, String:="kritish", TextOperator:=xlContains
End With
With .FormatConditions(.FormatConditions.count)
.Font.Color = vbRed
.Interior.Color = 14083324
.StopIfTrue = False
End With
End With
End Sub
I have a large table spanning from D5 to AM39. Each column has its average value in cell D40, E40, F40, etc. I want to format the cells so that if the number in that column is higher than the average, color green and if lower color red.
I am extremely new to VBA but have this script thus far that is supposed to color cells greater than average but does not work (I think it has something to do with Cells(4,39) index being wrong, but am not sure.
Application.CutCopyMode = False
With Range(Cells(5, 39), Cells(4, 39))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=$D40"
.FormatConditions(1).Interior.color = RGB(0, 150, 0)
End With
End Sub
Appreciate any tips
EDIT********
Using the record macro feature I believe I have a closer solution to what I am looking for, however, the formatting doesn't align with the averages per row (cells are red that should be green, and vice versa)
With Range(Cells(39, 4), Cells(5, 39)).Select
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=D$40"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=D$40"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End With
End Sub
Try this (using the built-in "compare to average" CF feature)
Sub AddCF()
Dim rngData As Range, col As Range
Set rngData = ActiveSheet.Range("D5:AM39") 'your table data
Application.ScreenUpdating = False
For Each col In rngData.Columns 'for each column in the data range
With col.FormatConditions.AddAboveAverage 'for >Avg
.AboveBelow = xlAboveAverage
.Interior.Color = vbRed
End With
With col.FormatConditions.AddAboveAverage 'for <Avg
.AboveBelow = xlBelowAverage
.Interior.Color = 5296274
End With
Next col
End Sub
If you want to use your existing average formulas:
Sub AddCF2()
Dim rngData As Range, col As Range, addr
Set rngData = ActiveSheet.Range("D5:AM39")
Application.ScreenUpdating = False
For Each col In rngData.Columns 'for each column in the data range
'absolute row, relative column address
addr = col.Cells(col.Cells.Count).Offset(1).Address(True, False) 'avg cell address
With col.FormatConditions
With .Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:="=" & addr)
.Font.Color = -16383844
.Interior.Color = 13551615
End With
With .Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=" & addr)
.Font.Color = -16752384
.Interior.Color = 13561798
End With
End With
Next col
End Sub
In vba Find the value in column by Color RGB(255,199, 206) and Write the single Value as "Duplicate" in next column.
Please view the snap for more understanding.
I am trying below code to highlight the Cells
and then I wanted to use new code to print "duplicate" infront of highlighted cells .
Can you please guide me .
Sub Highlight_Duplicate_Value()
Columns("AD:AD").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
End Sub
Thank You
Something like this? Note this only checks interior color.
Sub colorcheck()
Dim Checkrange As Range
Dim cell As Range
lastrow = ActiveSheet.Cells(Rows.Count, "AD").End(xlUp).Row
Set Checkrange = ActiveSheet.Range("AD1:AD" & lastrow)
For Each cell In Checkrange
If cell.DisplayFormat.Interior.Color = 13551615 Then
cell.Offset(0, 1).Value = "Duplicate"
End If
I have a macro that makes a formatting rule of multiple cell areas and must paint the cell yellow if it contains "S" and it works. But I would also like the cell to the right of the cell that contains "S" painted yellow, but only one cell to the right - not the whole row, is that possible? I imagine it's going to take place inside the "WITH statement, but I can not really move on
Sub Makro2()
Range("D6:E30,G6:H30,J6:K30,M6:N30,P6:Q30").Select
Range("P6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""S"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
I tried explaining in a comment the involvements of trying to conditional format of a discontinuous range. For the cell really processed by your shown code, you can accomplish what you need using the next code. The basis of conditional formatting behavior is that it formats only the cell where the conditional format belongs:
Sub Makro2Bis()
Dim rng As Range, offrng As Range
Set rng = Range("P6"): Set offrng = rng.Offset(0, 1)
With rng
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""S"""
.FormatConditions(1).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
With offrng
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & rng.Address(0, 0) & "= ""S"""
.FormatConditions(1).Interior.Color = rng.FormatConditions(1).Interior.Color
.FormatConditions(1).StopIfTrue = False
End With
End Sub
Please, test it and send some feedback.
Edited:
Please, test the (more complicated) version creating the conditional formatting for the discontinue range, in a way you asked for: The right neighbour cell will have the interior yellow, too:
Sub Makro3Bis()
Dim rng As Range, arr, rng1 As Range, rng2 As Range, rng3 As Range
Set rng = Range("D6:E30,G6:H30,J6:K30,M6:N30,P6:Q30")
arr = buildThreeRngs(rng)
Set rng1 = arr(0) 'the first column of the discontinuous range areas
Set rng2 = arr(1) 'the second column of the discontinuous range areas
Set rng3 = arr(2) 'the next column after the discontinuous range areas
With rng1
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""S"""
.FormatConditions(1).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
With rng2 'it will have two conditions. The second one relative to its left neighbour cell.
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""S"""
.FormatConditions(1).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & rng1.cells(1).Address(0, 0) & "= ""S"""
.FormatConditions(2).Interior.Color = rng1.FormatConditions(1).Interior.Color
.FormatConditions(2).StopIfTrue = False
End With
With rng3
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & rng2.cells(1).Address(0, 0) & "= ""S"""
.FormatConditions(1).Interior.Color = rng.FormatConditions(1).Interior.Color
.FormatConditions(1).StopIfTrue = False
End With
End Sub
Please, test it and send some feedback.
Second Edit:
Looking only to your picture and not basing on the code you posted, probably, the my first code (for one cell) adapted in the next way should be what you need:
Sub Makro2BisBis()
Dim rng As Range, offrng As Range
Set rng = Range("D6:D30,G6:G30,J6:J30,M6:M30,P6:P30")
Set offrng = rng.Offset(0, 1)
Debug.Print offrng.Address: Stop
With rng
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""S"""
.FormatConditions(1).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
With offrng
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & rng.cells(1).Address(0, 0) & "= ""S"""
.FormatConditions(1).Interior.Color = rng.FormatConditions(1).Interior.Color
.FormatConditions(1).StopIfTrue = False
End With
End Sub
It will make yellow the cells in the range you have in your code, but using only each area first column...
Please, test it and send some feedback.
Conditional Formatting in VBA
For the second part in Excel, you would use the following Conditional Formatting formula:
=D6="s"
The Code
Option Explicit
Sub Makro2()
Const ColOffset As Long = 1
Const Criteria As String = "s"
Dim rg As Range: Set rg = Range("D6:D30,G6:G30,J6:J30,M6:M30,P6:P30")
' xlCellValue
With rg
.ClearFormats
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""" & Criteria & """"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
' xlExpression
With rg.Offset(, ColOffset)
.ClearFormats
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & .Cells(1).Offset(, -ColOffset).Address(0, 0) _
& "=""" & Criteria & """"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
End Sub
I want to change "$F1" to cell(i,6) but its not working....why?
Sub macro2()
Dim i As Long
For i = 1 To 2
Cells(i, 6).Select
With Range(Cells(i, 1), Cells(i, 5))
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF(***$F1***>5,TRUE,FALSE)"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With
End With
End With
Next i
End Sub
You could try,
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF($F" & i & ">5, TRUE, FALSE)"
... but that formula is redundant. This produces exactly the same boolean results.
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$F" & i & ">5"
The formula you are using is dynamic. You do not need to loop through the rows. A CF rule formula acts as if it is an R1C1 formula; i.e. they are exactly the same for every cell in the Applies to: range. You could also set all of the i cells at once and avoid the loop.
with activesheet
with .range("F1:F2")
.FormatConditions.Add Type:=xlExpression, Formula1:= "=$F1>5"
with .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
.Interior.Color = 5287936
end with
end with
end with
Based on your code, it seems that the range you want to apply the FormatConditions is A1:E2. Also the FormatConditions is to be based on the value of column F for each Row. If this is correct then use the code below:
Sub FormatConditions_Dynamic()
Dim rRow As Range
For Each rRow In ActiveSheet.Range("A1:E2").Rows
With rRow
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=" & Cells(.Row, 6).Address(0) & ">5"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With: End With: End With: Next
End Sub