Article ID: 125848
Article Last Modified on 10/11/2006
Sub FindCircRefs()
' Get source information.
sourcesheet = ActiveSheet.Name
Sheets.Add
' Get destination information.
destsheet = ActiveSheet.Name
destrange = ActiveCell.Address
' Return to source.
Worksheets(sourcesheet).Activate
rowcount = 0
' Trap for error in "result", indicating no circular reference.
On Error GoTo notcircular
' Loop through every used cell in source.
For Each Item In ActiveSheet.UsedRange
' Check to see if cell contains a formula.
If Left(Item.Formula, 1) = "=" Then
' If cell intersects with precedents, cell has circular
' reference.
result = Intersect(ActiveSheet.Range(Item.Address), _
ActiveSheet.Range(Item.Precedents.Address))
Worksheets(destsheet).Range(destrange).Offset(rowcount, _
0).Value = Item.Address(False, False)
Worksheets(destsheet).Range(destrange).Offset(rowcount, _
1).Value = "'" & Item.Formula
rowcount = rowcount + 1
' Skip to here if not circular.
skipitem:
End If
Next
Exit Sub
' If error in "result", go here.
notcircular:
' Skip cells that do not contain circular references.
Resume skipitem
End Sub
To use this macro, run the FindCircRefs macro from the Microsoft Excel
worksheet for which you want to find circular references. A new sheet will
be added to the active workbook, listing the cell addresses of circular
references in column A, and the formula at that address in column B. If no
circular references are found, the new sheet will be empty.
Additional query words: 8.00 5.00c XL98 XL97 XL7 XL5 XL
Keywords: kbdtacode kbhowto kbprogramming KB125848