Advanced Color Coding of Multiple cells (CAD sheet)

[jnewlin]

I'm doing a CAD drawing in Excel and need to reference a cell's named range in VBA. Basically on Sheet1, I enter a number on say A1. Say column 1 is named BaseValues. I want to be able to reference BaseValues when the value in any cell in column 1 is changed. Here is some code I'm working with:

Private Sub Worksheet_Change(ByVal Target As Range)

' Loop through all names in workbook.
For Each n In ActiveWorkbook.Names
Dim b As Integer

' Set Error Handling so macro will not fail when it
' encounters a name that does not refer to a worksheet range.
On Error Resume Next
' Check to see if the name refers to the ActiveSheet.
If Mid(n.RefersTo, 2, InStr(n.RefersTo, "!") - 2) = _
ActiveSheet.Name Then b = 1
Next
If Intersect(Target, Range(n.Name)) Is Nothing Then
Exit Sub
Else
If ActiveCell.Value > 4 Then
For Each d In Range(n.Name).Value
d.Interior.ColorIndex = 0
Next d
ElseIf ActiveCell.Value = 4 Then
For Each d In Range(n.Name).Value
d.Interior.ColorIndex = 3
Next d
ElseIf ActiveCell.Value = 3 Then
For Each d In Range(n.Name).Value
d.Interior.ColorIndex = 44
Next d
ElseIf ActiveCell.Value = 2 Then
For Each d In Range(n.Name).Value
d.Interior.ColorIndex = 6
Next d
ElseIf ActiveCell.Value = 1 Then
For Each d In Range(n.Name).Value
d.Interior.ColorIndex = 4
Next d
Else
For Each d In Range(n.Name).Value
d.Interior.ColorIndex = 0
Next d
End If
End If
End Sub

You can see I'm trying to search through all the names on the worksheet and trying to find which name my cell is a part of. The second part uses that range in changing the color of all cells within that range.

Any suggestions on how to find the named range a cell is a part of and then how to reference it later in the subroutine?