excel - Trace back missing reference cell (Find precedents) -

introduction

i have spreadsheet formulas read vba macro. @ times, formulas link cells lost references. (the relation tree can go undefined number of levels)

problem statement

what achieve whenever happens, code returns user message box original rogue cell position. (trace error origin).

main difficulty facing following proper branch origin of error.

example

one workbook 2 worksheets following formulas:

• cell sheet1!a1 = =if(#ref!="", "", b2) (someone replaced original cell content , reference lost)
• cell sheet1!b1 = =a1
• cell sheet1!b2 = =11
• cell sheet2!a1 = =12
• cell sheet2!b1 = =a1+sheet1!a1+sheet1!b1

i interested in tracing sheet2!b1 original reference error.

and code tried far:

sub checkrangeb1()     dim rangeb1 range     dim rogueaddress string     set rangeb1 = sheets("sheet2").range("b1")      rogueaddress = missingref(rangeb1)     msgbox rogueaddress end sub  public function missingref(byval checkrange range) string     dim roguecell range     if iserror(checkrange)         if checkrange.value = cverr(xlerrref)             if hasprecedents(checkrange) = false                 missingref = checkrange.address             elseif iserror(checkrange.directprecedents)                 missingref = missingref(checkrange.directprecedents)             else                 missingref = checkrange.address             end if         end if     else         missingref = "noerror"     end if end function  public function hasprecedents(byval target range) boolean     on error resume next     hasprecedents = target.directprecedents.count end function 

which @ moment quite useless because .directprecedents tracing sheet2!a1.

edit

another approach may parsing formula , following referenced cells. not sure how extract referenced cells not knowing beforehand how formula look. still prefer .directprecedents approach. thanks.

finally solved although harder looked @ beginning.

the attached code traces original cell missing reference first 1 finds. (i.e. if there 2 cells missing references return first 1 only)

it should work case missing reference.

taking bits of code found on internet , following lead recursive vba precedents pointed @siddharth-rout got to:

option explicit sub checkrangeb1()     dim rangeb1 range, precedentsrange range     dim rogueaddress string     set rangeb1 = sheets("sheet2").range("b1")      dim precedentsstring variant     rogueaddress = missingref(rangeb1)     msgbox rogueaddress end sub  public function missingref(byval checkrange range) string     dim roguecell range     dim precedstring() string     dim returnstring string     dim errorcheck boolean     dim long, upperbound long     if iserror(checkrange)         if checkrange.value = cverr(xlerrref)             upperbound = ubound(findprecedents(checkrange))             redim precedstring(upperbound)             precedstring = findprecedents(checkrange)             if upperbound = 0 , precedstring(0) = ""                 missingref = "'" & checkrange.parent.name & "'!" & checkrange.address             else                 errorcheck = false                 = 1 ubound(precedstring)                     if iserror(range(precedstring(i)))                         errorcheck = true                         missingref = missingref(range(precedstring(i)))                         exit                     end if                 next                 if errorcheck = false                     missingref = "'" & checkrange.parent.name & "'!" & checkrange.address                 end if              end if         end if     else         missingref = "noerror"     end if end function  function findprecedents(byval rng range) variant     ' written bill manville     ' edits pauls     ' further edited lg     ' procedure finds cells direct precedents of active cell     dim returnrng() string     dim rlast range, ilinknum integer, iarrownum integer     dim stmsg string     dim bnewarrow boolean     application.screenupdating = false     rng.showprecedents     set rlast = rng     iarrownum = 1     ilinknum = 1     bnewarrow = true                         application.goto rlast             on error resume next             activecell.navigatearrow towardprecedent:=true, arrownumber:=iarrownum, linknumber:=ilinknum             if err.number > 0 exit             on error goto 0             if rlast.address(external:=true) = activecell.address(external:=true) exit             bnewarrow = false             if rlast.worksheet.parent.name = activecell.worksheet.parent.name                 if rlast.worksheet.name = activecell.parent.name                     ' local                     stmsg = stmsg & ";" & selection.address                 else                     stmsg = stmsg & ";" & "'" & selection.parent.name & "'!" & selection.address                 end if             else                 ' external                 stmsg = stmsg & ";" & selection.address(external:=true)             end if             ilinknum = ilinknum + 1  ' try link         loop         if bnewarrow exit         ilinknum = 1         bnewarrow = true         iarrownum = iarrownum + 1  'try arrow     loop     rlast.parent.cleararrows     application.goto rlast      if stmsg = ""         redim returnrng(0)         returnrng(0) = ""     else         redim returnrng(0 ubound(split(stmsg, ";")))         returnrng = split(stmsg, ";")     end if      findprecedents = returnrng()      'exit function end function 

hope finds usefull!

edit

when tried generalise code found error due use of .directprecedents doesn't trace references worksheet worksheet. droped fixed code.