Excel macro to compare adjacent cell value and highlight cell with same value in another column

I have data of questions, choices & answers.

Col-A has questions and choices starting with question 1 and choices A,B,C,D. Similarly I have 500 questions and each has choices.

Col-B has questions & Col-C has correct answers.

I am trying to find the correct answer for each question in Column-B and Column-C, and then highlight the correct answer in Column-A for each question.

Example: If Question 1 in Col-B has correct answer as B in Col-C, then in Col-A, the question 1 correct choice B must be highlighted in Green color.

Similarly loop for all questions and answers in Col-B & Col-C and highlight all correct choices in Col-A

ColA     ColB   ColC  
1        1      B
A        2      A
B        3      A
C
D

2
A
B
C
D

3
A
B
C
D

Solution

Use Dictionary object to track the location (row#) of question index .
The snippet can handle more choices. (eg. Q2 has 5 choices)

Microsoft documentation:

Dictionary object

Range.End property (Excel)

Interior.Color property (Excel)

Option Explicit

Sub Demo()
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey As String, iOffset As Long
    Dim arrData
    Set objDic = CreateObject("scripting.dictionary")
    ' Load data from Col A
    Set rngData = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    arrData = rngData.Value
    ' Loop through data
    For i = LBound(arrData) To UBound(arrData)
        sKey = arrData(i, 1)
        If IsNumeric(sKey) Then
            objDic(sKey) = i
        End If
    Next i
    ' Clear color formatting on Col A
    Range("A:A").Interior.Color = xlNone
    ' Load data from Col B and C
    Set rngData = Range("B1:C" & Cells(Rows.Count, 2).End(xlUp).Row)
    arrData = rngData.Value
    ' Loop through data
    For i = LBound(arrData) To UBound(arrData)
        sKey = arrData(i, 1)
        arrData(i, 2) = UCase(arrData(i, 2))
        If objDic.Exists(sKey) Then
            ' The distance between the choice and question index
            iOffset = Asc(arrData(i, 2)) - Asc("A") + 1
            ' Apply color formatting
            With Cells(objDic(sKey) + iOffset, 1)
                If UCase(.Value) = arrData(i, 2) Then _
                    .Interior.Color = vbGreen
            End With
        End If
    Next i
End Sub