Highlighting intersection cell of row and column VBA - vba

Question

I'm trying to record a macro in which if 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.
For example:
A11: "description"
Y1: "description"
->Y11 should be highlighted

Answer 1

Your answer doesn't seem to intuitively answer the question at hand: How to highlight an intersecting row and column on found match?
A naive approach would be to iterate through the columns and rows to find matches:
Private Sub ColorIntersection()
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
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

Answer 2

So this is what it is. Works perfectly with what I need (it also highlights a number of cells ahead of the one on the intersection)
Sub BorderForNonEmpty2()
Dim wb As Workbook
Dim wsCurrent As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set wsCurrent = wb.ActiveSheet
Dim atLastCompareDate As Boolean
Dim atLastMPDate As Boolean
Dim mPDateCounter As Integer
Dim compareDateCounter As Integer
mPDateCounter = 3
'loop over each row where the value in column c is not empty, starting at row 3
Do While Not atLastMPDate
Dim mPDate As String
mPDate = wsCurrent.Range("C" + CStr(mPDateCounter)).Value
atLastCompareDate = False
If (mPDate = Null Or mPDate = "") Then
atLastMPDate = True
Else
'loop over each column where the value in row 1 is not empty, starting at column e
compareDateCounter = 5
Do While (Not atLastCompareDate)
Dim compareDate As String
Dim currentCellColumn As String
If (compareDateCounter <= 26) Then
currentCellColumn = Chr((compareDateCounter) + 96)
Else
If (compareDateCounter > 26) And (compareDateCounter Mod 26 = 0) Then
currentCellColumn = Chr(Int(compareDateCounter / 26) - 1 + 96) + Chr(122)
Else
currentCellColumn = Chr(Int(compareDateCounter / 26) + 96) + Chr((compareDateCounter Mod 26) + 96)
End If
End If
compareDate = wsCurrent.Range(currentCellColumn + CStr(1)).Value
If (compareDate = Null Or compareDate = "") Then
atLastCompareDate = True
Else
If (compareDate = mPDate) Then
Dim cellLocation As String
If (compareDateCounter <= 26) Then
cellLocation = Chr((compareDateCounter) + 96)
Else
If (compareDateCounter > 26) And (compareDateCounter Mod 26 = 0) Then
cellLocation = Chr(Int(compareDateCounter / 26) - 1 + 96) + Chr(122)
Else
cellLocation = Chr(Int(compareDateCounter / 26) + 96) + Chr((compareDateCounter Mod 26) + 96)
End If
End If
wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Interior.ColorIndex = 11
'Loop backwards to mark the 6 dates before
Dim i As Integer
i = compareDateCounter - 1
Do While (i > compareDateCounter - 7)
If (i <= 26) Then
cellLocation = Chr((i) + 96)
Else
If (i > 26) And (i Mod 26 = 0) Then
cellLocation = Chr(Int(i / 26) - 1 + 96) + Chr(122)
Else
cellLocation = Chr(Int(i / 26) + 96) + Chr((i Mod 26) + 96)
End If
End If
wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Interior.ColorIndex = 43
wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Borders.LineStyle = xlContinuous
wsCurrent.Range(cellLocation + CStr(mPDateCounter)).Borders.ColorIndex = 11
i = i - 1
Loop
atLastCompareDate = True
End If
End If
compareDateCounter = compareDateCounter + 1
Loop
End If
mPDateCounter = mPDateCounter + 1
Loop
End Sub