Highlight range used in formula

[steve]

Hi
:hi:
I have a spreadsheet that has several hundred formulas on one sheet summing certain ranges on another sheet. Is it possible to highlight the cells that its summing using VBA.

Example of a couple of the formulas:
=SUM(Sheet1!CD1633:CD1643)+SUM(Sheet1!CD1786:CD1795)
=SUM(Sheet1!F325:F326,Sheet1!F370,Sheet1!F499:F509,Sheet1!F539,Sheet1!F552: F558,Sheet1!F562:F563,Sheet1!F575:F576,Sheet1!F587,Sheet1!F593:F595,Sheet1! F614:F616,Sheet1!F624:F627,Sheet1!F634:F636,Sheet1!F645:F646,Sheet1!F653:F6 56,Sheet1!F662:F664,Sheet1!F677:F679,Sheet1!F685:F686,Sheet1!F696:F698,Shee t1!F705:F707,Sheet1!F714:F716,Sheet1!F721,Sheet1!F726,Sheet1!F728:F732,Shee t1!F746:F748,Sheet1!F774,Sheet1!F780:F781,Sheet1!F789,Sheet1!F799:F803,Shee t1!F813:F814)+SUM(Sheet1!F820:F821,Sheet1!F837,Sheet1!F841,Sheet1!F852:F853 ,Sheet1!F858:F860,Sheet1!F864,Sheet1!F869:F870,Sheet1!F872:F874,Sheet1!F877 :F879,Sheet1!F895,Sheet1!F900:F905,Sheet1!F913:F914,Sheet1!F919:F920,Sheet1 !F922:F926,Sheet1!F935:F937,Sheet1!F941:F942,Sheet1!F945,Sheet1!F958,Sheet1 !F960:F962,Sheet1!F968:F970,Sheet1!F974,Sheet1!F985)+SUM(Sheet1!F989,Sheet1 !F991,Sheet1!F996:F998,Sheet1!F1003:F1006,Sheet1!F1014,Sheet1!F1021:F1022,S heet1!F1027,Sheet1!F1031,Sheet1!F1054,Sheet1!F1066:F1067,Sheet1!F1072,Sheet 1!F1078)

The spreadsheet was not setup by me and it does not reconcile to Sheet1 so need to find what cells are not included in the formulas.

Thanks for any help :bow:
Steve

[Tommy]

Hi steve,

The below sub will search the active sheet in formulas for "=Sum" and color all cells in the range red. :) If the sum is working on another sheet there may be problems.


Sub ColorSumRed()
Dim A() As String, mCol As Long, mRow As Long, NoWrap As Boolean
Dim mHldStr As String
Cells(1, 1).Activate
NoWrap = True
While NoWrap
Cells.Find(What:="=Sum", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If mRow = 0 Then
mRow = ActiveCell.Row
mCol = ActiveCell.Column
End If
mHldStr = ActiveCell.Formula
mHldStr = Replace(mHldStr, " ", "")
A = Split(Replace(mHldStr, "+", "!"), "!")
ParseString A
Cells.FindNext(After:=ActiveCell).Activate
If mRow = ActiveCell.Row And mCol = ActiveCell.Column Then
NoWrap = False
End If
Wend
End Sub
Sub ParseString(iInfo() As String)
Dim mI As Long, mSheetName As String, mRng As Range
For mI = 0 To UBound(iInfo)
If InStr(1, iInfo(mI), "(") > 0 Then
mSheetName = Mid(iInfo(mI), InStr(1, iInfo(mI), "(") + 1)
End If
If InStr(1, iInfo(mI), ")") > 0 Then
iInfo(mI) = Left(iInfo(mI), InStr(1, iInfo(mI), ")") - 1)
If ActiveSheet.Name <> mSheetName Then Worksheets(mSheetName).Activate
Range(iInfo(mI)).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ElseIf InStr(1, iInfo(mI), ",") > 0 Then
iInfo(mI) = Left(iInfo(mI), InStr(1, iInfo(mI), ",") - 1)
If ActiveSheet.Name <> mSheetName Then Worksheets(mSheetName).Activate
Range(iInfo(mI)).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Else
iInfo(mI) = vbNullString
End If
Next
End Sub


HTH

[mdmackillop]

Hi Steve,
This should handle other sheets as well. It might need some additional "Replace" terms, depending upon your formulae.
Regards
MD

Option Explicit
Option Compare Text
Sub Highlights()
Dim FormCells, Addy
Dim MyForm As String, i As Long
'Lose intervening text
MyForm = ActiveCell.Formula
MyForm = Replace(MyForm, "=", "")
MyForm = Replace(MyForm, "+", "")
MyForm = Replace(MyForm, "-", "")
MyForm = Replace(MyForm, "SUM", "")
MyForm = Replace(MyForm, ")", "")

'Replace opening bracket with comma
MyForm = Replace(MyForm, "(", ",")

'Split into parts
FormCells = Split(MyForm, ",")

For i = 1 To UBound(FormCells)
Addy = Split(FormCells(i), "!")
Debug.Print Addy(0) & " - " & Addy(1)
Sheets(Addy(0)).Range(Addy(1)).Interior.ColorIndex = 8
Next
End Sub