jhjorsal
jhjorsal

Reputation: 197

VBA MACRO to color ONE cell right to the Selected cells

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

enter image description here

Upvotes: 1

Views: 388

Answers (2)

FaneDuru
FaneDuru

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

VBasic2008
VBasic2008

Reputation: 54777

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

Upvotes: 1

Related Questions