Exceltips.nl

To use this macro, run the FindCircRefs macro from the Microsoft Excel worksheet for which you want to find circular references. A new sheet is 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 is empty.

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