Setting foreign keys constraint in excel using vba

Question

Say I have the following spreadsheet:

A      B            C      D       E     F     G        H        I
----------------------------------------------------------------------------
code   dataElem     age   sex    place   type  value    denom    denom_code
----------------------------------------------------------------------------
a1     population   all   all    all     num   10       1        1
a2     population   all   all    rural   num   6        1        1
a3     population   all   all    urban   num   4        1        1
a4     wealthy      all   all    all     %     40       10       a1
a5     wealthy      all   all    all     %     34       6        a2
a6     wealthy      all   all    all     %     50       4        a3
a7     Educated     all   all    all     %     70       10       a1
a8     Educated     all   all    all     %     50       6        a2
a9     Educated     all   all    all     %     100      4        a3
...

with values as given above, and where where cell A2-A4 (i.e. a1, a2 and a3) in column A & cell G2-G4 (10, 6 and 4) in column G are primary keys. I want to enforce that subsequent fields use the primary keys defined above as foreign keys. That is new records entered must be checked against the foreign key cells, which are column H (denom) and column I (denom_code). To further explain, whenever I choose to enter a new record say row 5 (a4, wealthy, all, all, all, %, 40, 10, a1), the code checks to ensure that both H5 and I5 correspond to A2=a1 and G2=10. Also for row6 (a5, wealthy, all, all, all, %, 34, 6, a2), both H6 and I6 correspond to A3=a2 and G3=6. How do I achieve this in excel vba.

Sub sbHighlightDuplicatesInColumn()
    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long

    lastRow = Sheets("Sheet1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For iCntr = 1 To lastRow
        If Cells(iCntr, 1) <> "" Then
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range(Cells(1, 1), Cells(iCntr, 1)), 0)
            If iCntr <> matchFoundIndex Then
                Sheets("Sheet1").Cells(iCntr, 1).Interior.Color = vbYellow
            End If
        End If
    Next

    'iterating over the 2 columns...

    numOfRows = ActiveWorkbook.Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Range("A2").End(xlDown)).Rows.Count
    freq = numOfRows / 12

    Dim lastRowL As Long
    lastRowL = Sheets("Sheet1").Range("L1").SpecialCells(xlCellTypeLastCell).Row

    Dim LastRowM As Long
    LastRowM = Sheets("Sheet1").Range("M1").SpecialCells(xlCellTypeLastCell).Row

    Dim rg1 As Range, rg2 As Range
    Set rg1 = ActiveWorkbook.Worksheets("Sheet1").Range("A2:A4")
    Set rg2 = ActiveWorkbook.Worksheets("Sheet1").Range("G2:G4")

    ' Create dynamic array
    Dim tmpArray1 As Variant, tempArray2 As Variant
    Dim code As Variant, value As Variant

    'Dump the range into a 2D array
    tmpArray1 = rg1.value
    tmpArray2 = rg2.value

    'Resize the 1D array
    ReDim code(1 To UBound(tmpArray1, 1))
    ReDim value(1 To UBound(tmpArray2, 1))

    'Convert 2D to 1D
    For i = 1 To UBound(code, 1)
        code(i) = tmpArray1(i, 1)
        value(i) = tmpArray2(i, 1)
    Next

    For cnt = 1 To freq
        'iterate over col-L
        Dim u As Integer, v As Integer
        u = cnt * 3 + 2
        v = u + 2

        Dim iTrack As Integer
        iTrack = 1
        'iterate over col-L
        For iCntr = u To v
            If Cells(iCntr, 8) <> "" Then
                matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 8), Range(Cells(1, 8), Cells(iCntr, 8)), 0)
                If code(iTrack) <> matchFoundIndex Then
                    Sheets("Sheet1").Cells(iCntr, 8).Interior.Color = vbYellow
                Else
                    Sheets("Sheet1").Cells(iCntr, 8).Interior.Color = vbGreen
                End If
            End If
            iTrack = iTrack + 1
        Next

        iTrack = 1
        'iterate over col-M
        For iCntr = u To v
            If Cells(iCntr, 9) <> "" Then
                matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 9), Range(Cells(1, 9), Cells(iCntr, 9)), 0)
                If value(iTrack) <> matchFoundIndex Then
                    Sheets("Sheet1").Cells(iCntr, 9).Interior.Color = vbRed
                Else
                    Sheets("Sheet1").Cells(iCntr, 9).Interior.Color = vbGreen
                End If
            End If
            iTrack = iTrack + 1
        Next
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim curColor As Variant
    curColor = ActiveCell.Interior.Color
    If Application.CountIf(Range("A:A"), Target) > 1 Then
        MsgBox "Duplicate Data", vbCritical, "Remove Data"
        Target.value = ""
        'ActiveCell.Offset(RowOffset:=-1).EntireRow.Interior.Color = curColor
    End If
End Sub