[I]Sub HighlightCellsReferenced()[/I]
[I]    Dim rowCnt As Integer[/I]
[I]    Dim i As Integer, j As Integer, strleng As Integer[/I]
[I]    Dim strTxt As String, strFml As String[/I]
[I]    Dim columnStr, cellsAddress As String[/I]
[I]    Dim xRg As Range, yRg As Range[/I]
[I]    On Error Resume Next[/I]
[I]    Set xRg = Application.InputBox(Prompt:="Please select formula cell(s)...", _[/I]
[I]    Title:="Kutools For Excel", Type:=8)[/I]
[I]    [/I]
[I]    strTxt = ""[/I]
[I]    Application.ScreenUpdating = False[/I]
[I]    For Each yRg In xRg[/I]
[I]        If yRg.Value <> "" Then[/I]
[I]            strFml = yRg.Formula + " "[/I]
[I]            strFml = Replace(strFml, "(", " ")[/I]
[I]            strFml = Replace(strFml, ")", " ")[/I]
[I]            strFml = Replace(strFml, "-", " ")[/I]
[I]            strFml = Replace(strFml, "+", " ")[/I]
[I]            strFml = Replace(strFml, "*", " ")[/I]
[I]            strFml = Replace(strFml, "/", " ")[/I]
[I]            strFml = Replace(strFml, "=", " ")[/I]
[I]            strFml = Replace(strFml, ",", " ")[/I]
[I]            strFml = Replace(strFml, ":", " ")[/I]
[I]              [/I]
[I]            For j = 1 To Len(strFml)[/I]
[I]                If Mid(strFml, j, 1) <> " " Then[/I]
[I]                    cellsAddress = cellsAddress + Mid(strFml, j, 1)[/I]
[I]                Else[/I]
[I]                    On Error Resume Next[/I]
[I]                    Range(cellsAddress).Interior.ColorIndex = 3[/I]
[I]                    cellsAddress = ""[/I]
[I]                End If[/I]
[I]            Next[/I]
[I]        End If[/I]
[I]    Next yRg[/I]
[I]    Application.ScreenUpdating = True[/I]
[I]End Sub