Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#Else
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#End If
Private Const TARGET_RANGE_ADDRESS = "B3:H3" '<== change range addrss to suit.
Private Sub Worksheet_Calculate()
Dim tCurPos As POINTAPI, Obj As Object, oTargetRange As Range
If ActiveSheet Is Me Then
Call GetCursorPos(tCurPos)
Set Obj = ActiveWindow.RangeFromPoint(tCurPos.X, tCurPos.Y)
Set oTargetRange = Range(TARGET_RANGE_ADDRESS)
If TypeName(Obj) = "Range" Then
With oTargetRange
If Union(Obj, oTargetRange).Address = .Address Or _
Union(Selection, oTargetRange).Address = .Address Then
Call HighlightSortHeader(Me, vbYellow)
End If
End With
End If
End If
End Sub
Private Sub HighlightSortHeader(ByVal Sh As Worksheet, Optional ByVal Color As Long)
Dim i As Long
If Not Sh.AutoFilter Is Nothing Then
With Sh.AutoFilter
.Range.Resize(1, .Range.Columns.Count).Interior.ColorIndex = 0
For i = 1 To .Sort.SortFields.Count
.Sort.SortFields(i).Key(1).Interior.Color = IIf(Color = 0, vbYellow, Color)
Next i
End With
End If
End Sub