excel - Code takes too long to run , ends up crashing at times -

hi there have code run after few moments. stops responding , run again .need run faster without crashing. here code

sub deletecells()      dim r range     'set rng = nothing     on error resume next     set r = application.inputbox("select cells deleted", type:=8)     dim rng range    dim rngerror range   set rng = sheets("sheet3").range("a1:g100")    set rngerror = rng.cells.specialcells(xlcelltypeformulas, xlerrors)     if typename(r) <> "range"         exit sub     else     r.delete    end if    each cell in rng  if cell.text = "#ref!"   cell.entirecolumn.delete  end if      'delete means cells move after deleting entire row      'rngerror.entirerow.clearcontents means contents clear, leaving blank cell entire row next     end sub 

you deleting cells in loop can make slow. trying? should fast... (untested)

sub deletecells()     dim rng range, rngerror range, delrange range     dim long, j long      on error resume next     set rng = application.inputbox("select cells deleted", type:=8)     on error goto 0      if rng nothing exit sub else rng.delete      sheets("sheet3")         = 1 7 '<~~ loop trough columns g             '~~> check if column has errors             on error resume next             set rngerror = .columns(i).specialcells(xlcelltypeformulas, xlerrors)             on error goto 0              if not rngerror nothing                 j = 1 100 '<~~ loop through rows 1 100                     if .cells(j, i).text = "#ref!"                         '~~> store range deleted                         if delrange nothing                             set delrange = .columns(i)                             exit                         else                             set delrange = union(delrange, .columns(i))                         end if                     end if                 next             end if         next     end      '~~> delete range in 1 go     if not delrange nothing delrange.delete end sub