Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Highlight Column A and B only

0

I have this amazing code, but it highlights all coolumns in sheet. Any way to get this vba code to only highlight columns A and B?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Const RefClm As Long = 1                ' specified column B
                                            ' change as appropriate
    Dim Rng As Range
    Dim RefRng As Range
    Dim Fnd As Range, Rf As Long
    Dim Ref As Variant
    Dim Cl As Long                          ' Last used column in row 1
    Dim R As Long

    Cl = Cells(1, Columns.Count).End(xlToLeft).Column
    Set Rng = Range(Cells(2, 1), Cells(Cells(Rows.Count, RefClm).End(xlUp).Row, Cl))
    Set Target = Target.Cells(1)
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        Ref = Cells(Target.Row, RefClm).Value
        Rng.Interior.Pattern = xlNone
        Set RefRng = Rng.Columns(RefClm)
        With RefRng
            ' Find method: https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2003/aa195730(v=office.11)
            Set Fnd = .Find(What:=Ref, After:=.Cells(.Cells.Count), LookAt:=xlWhole)
        End With
        Rf = Fnd.Row
        Set Target = Range(Cells(Rf, 1), Cells(Rf, Cl))

        Do
            Set Fnd = RefRng.FindNext(After:=Fnd)
            If (Fnd Is Nothing) Or (Fnd.Row = Rf) Then
                Exit Do
            Else
                Set Target = Union(Target, Range(Cells(Fnd.Row, 1), Cells(Fnd.Row, Cl)))
            End If
        Loop

        Target.Interior.Color = vbYellow
    End If
End Sub
Answer
Discuss

Answers

0
Selected Answer

Brad,

Not sure how you use this macro but you can change just two lines and the yellow highlighting will be only on columns 1 and 2. See the new comments and following line changes in bold below (implemented in the attached revised file):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Const RefClm As Long = 1                ' specified column B
                                            ' change as appropriate
    Dim Rng As Range
    Dim RefRng As Range
    Dim Fnd As Range, Rf As Long
    Dim Ref As Variant
    Dim Cl As Long                          ' Last used column in row 1
    Dim R As Long

    Cl = Cells(1, Columns.Count).End(xlToLeft).Column
    Set Rng = Range(Cells(2, 1), Cells(Cells(Rows.Count, RefClm).End(xlUp).Row, Cl))
    Set Target = Target.Cells(1)
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        Ref = Cells(Target.Row, RefClm).Value
        Rng.Interior.Pattern = xlNone
        Set RefRng = Rng.Columns(RefClm)
        With RefRng
            ' Find method: https://docs.microsoft.com/en-us/previous-versions/office/developer/office-2003/aa195730(v=office.11)
            Set Fnd = .Find(What:=Ref, After:=.Cells(.Cells.Count), LookAt:=xlWhole)
        End With
        Rf = Fnd.Row
        ' limit to columns A and B
        Set Target = Range(Cells(Rf, 1), Cells(Rf, 2))

        Do
            Set Fnd = RefRng.FindNext(After:=Fnd)
            If (Fnd Is Nothing) Or (Fnd.Row = Rf) Then
                Exit Do
            Else
                ' limit to columns A and B
                Set Target = Union(Target, Range(Cells(Fnd.Row, 1), Cells(Fnd.Row, 2)))
            End If
        Loop

        Target.Interior.Color = vbYellow
    End If
End Sub

Hope this works for you.

Discuss

Discussion

Brad- did you see my Answer? 
John_Ru (rep: 4332) Aug 22, '22 at 12:35 pm
Yes worked perfectly thank you
Sroncey21 (rep: 66) Aug 22, '22 at 12:36 pm
Great! Thanks for selecting my Answer, Brad.
John_Ru (rep: 4332) Aug 22, '22 at 1:02 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login