Reputation: 197
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
Upvotes: 1
Views: 388
Reputation: 42236
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.
Upvotes: 1
Reputation: 54777
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
Upvotes: 1