VBA: Conditional formatting based on a check mark

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

VBA: Conditional formatting based on a check mark

Post by gailb »

Need a little help here. I would like to via VBA add some conditional formatting to the group of cells D2:E13 and G2:G8.

This is just a sample as you can see by the code everything is meant to be dynamic as far as the LastRow. This is just a small part of a larger VBA project.

With the VBA I can apply it to D2:E13, but with the formula having a absolute reference it won't apply properly to B2:G8.

Based on a check mark in column E, I would like column D:E to highlight by the VBA. Example attached which hopefully helps.
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78238
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA: Conditional formatting based on a check mark

Post by HansV »

What kind of conditional formatting do you want to apply? And what should be dynamic?

I'd set up the conditional formatting for each of the columns separately.
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78238
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA: Conditional formatting based on a check mark

Post by HansV »

Does this do what you want?

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim c As Range
    Dim s As String
    Dim m As Long
    m = Range("D" & Rows.Count).End(xlUp).Row
    If Not Intersect(Range("E2:E" & m), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        If Target.Value = "" Then
            Target.Value = "a"
        Else
            Target.ClearContents
        End If
        For Each c In Range("E2:E" & m)
            If c.Value = "a" Then
                s = s & ", " & c.Offset(0, -1).Value
            End If
        Next c
        If s <> "" Then
            s = Mid(s, 3)
        End If
        Range("A2").Value = s
        Application.EnableEvents = True
    End If
    m = Range("G" & Rows.Count).End(xlUp).Row
    If Not Intersect(Range("H2:H" & m), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        If Target.Value = "" Then
            Target.Value = "a"
        Else
            Target.ClearContents
        End If
        For Each c In Range("H2:H" & m)
            If c.Value = "a" Then
                s = s & ", " & c.Offset(0, -1).Value
            End If
        Next c
        If s <> "" Then
            s = Mid(s, 3)
        End If
        Range("A3").Value = s
        Application.EnableEvents = True
    End If
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: VBA: Conditional formatting based on a check mark

Post by gailb »

Thanks Hans. It didn't even cross my mind to put it in the DoubleClick event.

I added the bolded parts and this meets my needs. I only did it on the first part for the below, but will add to the other part.

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim c As Range
    Dim s As String
    Dim m As Long
    m = Range("D" & Rows.Count).End(xlUp).Row
    If Not Intersect(Range("E2:E" & m), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        If Target.Value = "" Then
            Target.Value = "a"
[b]            Target.Interior.ColorIndex = 45 'Added
            Target.Offset(0, -1).Interior.ColorIndex = 45 'Added[/b]
        Else
            Target.ClearContents
[b]            Target.Interior.ColorIndex = -4142  'Added
            Target.Offset(0, -1).Interior.ColorIndex = -4142  'Added[/b]
        End If
        For Each c In Range("E2:E" & m)
            If c.Value = "a" Then
                s = s & ", " & c.Offset(0, -1).Value
            End If
        Next c
        If s <> "" Then
            s = Mid(s, 3)
        End If
        Range("A2").Value = s
        Application.EnableEvents = True
    End If
    m = Range("G" & Rows.Count).End(xlUp).Row
    If Not Intersect(Range("H2:H" & m), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        If Target.Value = "" Then
            Target.Value = "a"
        Else
            Target.ClearContents
        End If
        For Each c In Range("H2:H" & m)
            If c.Value = "a" Then
                s = s & ", " & c.Offset(0, -1).Value
            End If
        Next c
        If s <> "" Then
            s = Mid(s, 3)
        End If
        Range("A3").Value = s
        Application.EnableEvents = True
    End If
End Sub