VBA根据不同工作表上范围内的值更改单元格颜色

Question

I have a main form (Sheet2) where the users enter a long code in column C and in column D there is a formula set to take just the last 6 digits of the long code. If those values derived from the formula in cell D equal any values listed in column C of a separate sheet called "ref_list" (Sheet5) then I'd like the corresponding cell in the F column of the main sheet to turn red. Once the cell color is red, the user will be able to click on the red colored cell in column F and be navigated to a list of values associated with the 6 digit value in column D.

So, if the 6 digit code derived in column D is "123ABC" and that value is equal to one of the codes listed in column C of Sheet5, then I'd like the F column cell of the same row to turn red and be clickable. Once clicked it will trigger a macro listing all values associated with "123ABC".

Right now, I have hard coded these values and the macros associated with them. I don't want to hard code these values so I put them in a range. But, I am having trouble getting the logic to work. Once the range is set up, how can I specify which cells to turn red and how to trigger the proper macro associated with the 6 digit values. I have researched range in vba but on how to call macros based on range values, I have't had much luck finding any resources. Here is the code I have so far for it.

 Sub cellColorChange()

Dim acctCode As Range
Set acctCode = Sheet2.Range("D7:D446").Value

Dim refCodes As Range
Set refCodes = Sheet5.Range("C1:C20").Value

Dim changeColor As Range
Set changeColor = Sheet2.Range("F7:F446").Value

If acctCode.Value = refCodes.Value Then
changeColor.ActiveCell.Interior.Color = 3
Else
ActiveCell.Interior.Color = 0
End If

End Sub

Answer 1

My setup is Sheet2 and Sheet5 ("ref_list") - both sheets have headers

This is what the code bellow does

Sheet2 (main sheet)

---

Sheet5 ("ref_list")

---

Execute main sub ShowCells() - result

---

Clicking the link in F3 filters all items containing value "123BCD"

---

Clicking the link in F3 again (in filter mode), clears the filter

---

Code

---

A new VBA module containing these 2 subs:

Option Explicit

Private Const S2 = "Sheet2" 'Name of the main sheet
Private Const WS1_COL = 4   'Column in main sheet (D)
Private Const WS1_F = 6     'Column in main sheet (F)
Private Const WS2_COL = 3   'Column in ref_list sheet (C)

Public Sub ShowCells()
    Dim ws1 As Worksheet, ws2 As Worksheet, r1 As Long, r2 As Long
    Dim ur1 As Variant, ur2 As Variant, ub2 As Long, cel As Range, lnk As Range

    Set ws1 = ThisWorkbook.Sheets(S2)
    Set ws2 = ThisWorkbook.Sheets("ref_list")

    ur1 = ws1.UsedRange.Columns(WS1_COL)
    ur2 = ws2.UsedRange.Columns(WS2_COL)
    ub2 = UBound(ur2)

    Application.ScreenUpdating = False
    For r1 = 2 To UBound(ur1)
        For r2 = 2 To ub2
            If ur1(r1, 1) = ur2(r2, 1) Then
                Set cel = ws1.Cells(r1, WS1_COL)
                Set lnk = cel.Offset(0, WS1_F - WS1_COL)
                lnk.Interior.ColorIndex = 3
                ws1.Hyperlinks.Add Anchor:=lnk, Address:="", SubAddress:=cel.Address
                Exit For
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

---

Public Sub ShowRefs(ByVal id As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(S2)
    ws.UsedRange.Columns(WS1_COL).AutoFilter Field:=1, Criteria1:=ws.Range(id).Value
End Sub

---

In VBA module for main sheet (Sheet2)

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If Me.AutoFilter Is Nothing Then
        ShowRefs Target.SubAddress
    Else
        Me.UsedRange.AutoFilter
    End If
End Sub