Need help with eisting event code to in regards to recording row of active color cell

[estatefinds]

I have an event code that colors the interior cells in yellow based on the
Combination selected,
These actively colored cells are colored; there are 5 at a time in the
Range H5 to L27

Once I select each combination for example you’ll see that the numbers that have no interior color will be colored in yellow 5 at a time.
Now there is a range of data Q 5 to U 27 same color pattern unfilled and
The ones filled in red. The range is starting at Q 5 to Q 27, R 5 to R 2, S 5 to S 27 , T 5 to T 27, U 5 to U 27 .
These are the numbers I want to call for example in
Q5 will be labeled row 1, R 11 is Row 7 and so on.

So Every time I select a number for example in column A the combination 1-2-3-7-9 the numbers in the range H 5 to H 27 will be colored in yellow.

What I’m trying to get help on is a macro that will also color the interior of the cells of the same location, For example:

So you can see the 5 cells in the range H5 to H 27 are colored in yellow and the corresponding range to the right in range Q 5 to Q 27 are colored in yellow in the same cells but when the cells in the range Q 5 to Q 27 are colored in yellow the row number that is in the cells that is colored yellow will be recorded in the column W starting at W 11 for example 1-5-7-12-18.

The length of the range will change so it needs to be able to run on any length.
Any help on this is much appreciated!
Thank you!!!

Sub test()    Dim keyCell As Range
    Dim SearchRange As Range
    Dim writeCell As Range, oneCell
    Dim Numerals As Variant, i As Long
     
    If Selection.Column <> 1 Then Beep: Exit Sub
     
    Set keyCell = Selection.Cells(1, 1)
    Numerals = Split(CStr(keyCell.Value), "-")
    With keyCell
        Set SearchRange = Range(.Cells(2, 1), .EntireColumn.Cells(Rows.Count, 1).End(xlUp))
    End With
    SearchRange.Offset(0, 1).Resize(, 5).ClearContents
     
    For i = 0 To UBound(Numerals)
        Set writeCell = Nothing
        For Each oneCell In SearchRange
            If IsNumeric(Application.Match(Numerals(i), Split(oneCell.Value, "-"), 0)) Then
                Set writeCell = oneCell
                Exit For
            End If
        Next oneCell
         
        If Not writeCell Is Nothing Then
            With writeCell
                .Offset(0, Application.Match(Numerals(i), Split(.Value, "-"), 0)).Value = writeCell.Row - keyCell.Row
            End With
        End If
    Next i
End Sub