Coloring cells that have dependents to other cells - excel

Question

I have made a code that checks if the cells value has been referred in any other sheet. Simply it checks the cells Dependency and colours it.
Basically what I did is it goes to the cell dependancy and if the sheet name is not the one it was at the first, it colours it. Here is the code
Dim r As Long, c As Long, sh As Worksheet, name As String, rg As Range, chksh As String ' r is row and c is coloumn
Application.ScreenUpdating = False
Application.EnableEvents = False
name = "Main sheet"
Set sh = ThisWorkbook.Sheets(name)
Set rg = sh.Range("A4").CurrentRegion
r = rg.Rows.Count
c = rg.Columns.Count
Dim i As Long, j As Long
i = 1
j = 1
sh.Select
Do While i < r + 1
j = 1
Do While j < c + 1
sh.Cells(i, j).Select
Selection.ShowDependents
ActiveCell.NavigateArrow TowardPrecedent:=False, ArrowNumber:=1, _
LinkNumber:=1
chksh = ActiveSheet.name
If chksh <> name Then 'there is a dependent in other sheet
sh.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
j = j + 1
Loop
i = i + 1
Loop
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
It takes too much time due to the .select use.
Please suggest an improved code without the use of select so that it can run in a blink of an eye.

Answer 1

Simplified:
Sub Tester()
Dim sh As Worksheet, rg As Range, c As Range
Set sh = ThisWorkbook.Sheets("Main sheet")
Set rg = sh.Range("A4").CurrentRegion
For Each c In rg.Cells
c.ShowDependents
c.NavigateArrow TowardPrecedent:=False, ArrowNumber:=1, LinkNumber:=1
If ActiveSheet.name <> sh.name Then
c.Interior.Color = vbRed
End If
Next c
sh.ClearArrows
End Sub