Auditing cells: Find "dangling"cells

S

Sige

Hi There,

It is the time of the year again ...where I receive a ton of
spreadsheets with "massacred" templates. Finding "constants in
formulas" is an incredible tool by Norman Jones which solved already a
lot of my misery!

Here is another issue:
-I would like to find the cells on my active sheet / selection that are
"not used". Meaning that they do not serve as input or further
calculation ...
I.e. they do not have dependents.
-Possible to trigger also those cells which have dependents in other
sheets in the active wbk


Best Regards, Sige


PS: XL97
 
G

Guest

Sige,

Try;

Dim ranCell As Range

For Each ranCell In Selection

On Error Resume Next

Debug.Print ranCell.Dependents.Count

If Err.Number = 1004 Then

ranCell.Interior.Color = vbBlue

End If

Err.Clear
On Error Resume Next

Next ranCell

'Dependents' seems to return an error rather than zero on the count - which
is a bit annoying - I'm sure someone will chime in if there is a better way.

Regards,

Chris.
 
S

Sige

Hi Chris,

Thanks a lot!
Not that I completely understand it ...
If Err.Number = 1004 Then ???
Click to expand...

If the cell is dependent to a cell(s) in another sheet (active wbk);
could it be possible to (in this case: not trigger) trigger these as
well?

I added an IF to exclude empty cells....
Sige

Sub Has_No_Dependents()
Dim ranCell As Range
For Each ranCell In Selection

On Error Resume Next
Debug.Print ranCell.Dependents.Count

If Err.Number = 1004 Then
If Not IsEmpty(ranCell) Then
ranCell.FormatConditions.Add Type:=xlExpression,
Formula1:="=TRUE"
ranCell.FormatConditions(1).Interior.ColorIndex = 3
' ranCell.Interior.Color = vbBlue
End If
End If
Err.Clear
On Error Resume Next
Next ranCell
End Sub
 
G

Guest

Sige,

Yes it is a bit limited. 'Dependents' etc are limited to the active sheet

If you add an extra sheet 'Formula' to the book you can 'catalogue' all the
formulae in it using the following code

Dim xlsWorksheet As Excel.Worksheet
Dim ranCell As Range
Dim lRowPointer As Long
Dim sFormula As String

lRowPointer = 2
ThisWorkbook.Sheets("Formula").Cells.ClearContents

For Each xlsWorksheet In ThisWorkbook.Worksheets

For Each ranCell In xlsWorksheet.Range(xlsWorksheet.Cells(1, 1),
xlsWorksheet.Cells.SpecialCells(xlCellTypeLastCell))

sFormula = ranCell.Formula

If sFormula <> "" Then
If InStr(sFormula, "!") <> 0 Then

ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 1) =
Mid(sFormula, 2, InStr(sFormula, "!") - 2)
ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 2) =
Right(ranCell.Formula, Len(sFormula) - InStrRev(sFormula, "!"))
Else
ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 1) =
xlsWorksheet.Name
ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 2) =
Right(sFormula, Len(sFormula) - 1)
End If
lRowPointer = lRowPointer + 1
End If

Next ranCell

Next xlsWorksheet

ThisWorkbook.Sheets("Formula").Cells(1, 1) = "Sheet"
ThisWorkbook.Sheets("Formula").Cells(1, 2) = "Formula"

Note I think that 'SpecialCells' is only updated after a save. We could then
look up against this list to see if a cell is referenced anywhere ... but
this is starting to get complicated.

Regards,

Chris.
 
S

Sige

Hi Chris,

I ünderstand what your sub would do ... it would help me a great deal
further!
However my VBA(XL97) does not understand "InStr" ? !
Note I think that 'SpecialCells' is only updated after a save. We could then
look up against this list to see if a cell is referenced anywhere ... but
this is starting to get complicated.
Click to expand...
I agree. No need for it!

Brgds Sige
 
G

Guest

Sige,

Instr should work on XL97 - I suspect it is the InstrRev (which could
probably be replaced by Instr) that is not supported.

Try that & let me know if it still does not work.

Regards,

Chris.
 
S

Sige

Hi Chris,
Instr should work on XL97 - I suspect it is the InstrRev that is not supported.
Click to expand...
Absolutely right! Copied the wrong one ...
(which could probably be replaced by Instr)
Click to expand...
The sub does not bug ...but the output is "bizar"...
On the formula-sheet: A1:B254

Sheet Formula
Sheet1
Sheet1
Sheet1 SUM(A1:A2)
Sheet1 A3+50
Formula heet1
Formula heet1
Formula heet1
Formula UM(A1:A2)
Formula heet1
Formula 3+50
Formula ormula
Formula eet1
Formula ormula
Formula eet1
Formula ormula
Formula eet1
Formula ormula
Formula M(A1:A2)
Formula ormula
Formula eet1
Formula ormula
Formula 50
Formula ormula
Formula rmula
....

Hmmm, it is cryptic ;o)
Sige
 
G

Guest

Sige,

My code was perhaps a little sensitive to initial conditions, hence the
chaos that ensued ...

It needs to ignore anything on the 'Formula' tab, and also stuff that does
not start '=', try the following;

Public Sub Audit()

Dim xlsWorksheet As Excel.Worksheet
Dim ranCell As Range
Dim lRowPointer As Long
Dim sFormula As String

lRowPointer = 2
ThisWorkbook.Sheets("Formula").Cells.ClearContents

For Each xlsWorksheet In ThisWorkbook.Worksheets

If xlsWorksheet.Name <> "Formula" Then

For Each ranCell In xlsWorksheet.Range(xlsWorksheet.Cells(1, 1),
xlsWorksheet.Cells.SpecialCells(xlCellTypeLastCell))

sFormula = ranCell.Formula

If sFormula <> "" Then

If Left(sFormula, 1) = "=" Then

If InStr(sFormula, "!") <> 0 Then


ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 1) = Mid(sFormula, 2,
InStr(sFormula, "!") - 2)

ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 2) = Right(ranCell.Formula,
Len(sFormula) - InStr(sFormula, "!"))

Else


ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 1) = xlsWorksheet.Name

ThisWorkbook.Sheets("Formula").Cells(lRowPointer, 2) = Right(sFormula,
Len(sFormula) - 1)

End If

lRowPointer = lRowPointer + 1

End If

End If

Next ranCell

End If

Next xlsWorksheet

ThisWorkbook.Sheets("Formula").Cells(1, 1) = "Sheet"
ThisWorkbook.Sheets("Formula").Cells(1, 2) = "Formula"

End Sub

Regards,

Chris.
 
Top