CODEWITHSUNDEEP
excelvbaconditional-formatting
sant
sant

Reputation: 101

Highlight intersection cell of row and column based on Text matching using VBA

I am trying to use VBA by which when the text in a column header is the same as the text in a row the intersection cell of the row and the column gets highlighted with some Color.

Example: I tried with below Code but not giving the required output

Sub cellintersection()
Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim cols As Range, rws As Range
    Dim lastRow As Integer: lastRow = ws.UsedRange.Rows.Count
    Dim lastColumn As Integer: lastColumn = ws.UsedRange.Columns.Count

    For Each cols In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastColumn))
        If (Not (cols.Value = vbNullString)) Then
            For Each rws In ws.Range("A1:A" & lastRow)
                If (rws.Value = cols.Value) Then ws.Cells(rws.Row, cols.Column).Interior.Color = 5296210
            Next
        End If
    Next

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Required Output: The cells with green by matching the text with blue.

Output

Upvotes: 0

Views: 852

Answers (2)

JvdV
JvdV

Reputation: 75990

So with conditional formatting as per my comment:

enter image description here

  • Select range B4:D6

  • Start > Conditional Formatting > New Rule > Formula:

    =B$2=$A4

  • Choose your fill color and confirm

Notice, filling cells through VBA is static while conditional formatting is dynamic and will change according to changes made to your data.

Upvotes: 3

riskypenguin
riskypenguin

Reputation: 2199

I fixed some errors I found:

Sub cellintersection()
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim ws As Worksheet
Set ws = ActiveSheet

Dim cols As Range, rws As Range
Dim lastRow As Integer: lastRow = ws.UsedRange.Rows.Count
Dim lastColumn As Integer: lastColumn = ws.UsedRange.Columns.Count

For Each cols In ws.Range(ws.Cells(2, 1), ws.Cells(2, lastColumn))
    If cols.Value <> vbNullString Then
        For Each rws In ws.Range("A1:A" & lastRow)
            If rws.Value = cols.Value Then ws.Cells(rws.Row, cols.Column).Interior.Color = 5296210
        Next
    End If
Next

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

When starting the first For...Each Loop you are looking through row 1, which does not have any values in it. Your headers are in row 2. Also some of your If statements were unneccesarily complicated, for example

If (Not (cols.Value = vbNullString)) Then

is the same as

If cols.Value <> vbNullString Then

Upvotes: 1

Related Questions