Coloring cells that have dependents to other cells

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.

https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — braX, Oct 30 '19 at 05:37

score 0 · Answer 1 · answered Oct 30 '19 at 05:45

0

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

answered Oct 30 '19 at 05:45

Tim Williams

154,628
8
97
125

But it takes the same amount of time. How can I make this faster? – Rick21 Oct 30 '19 at 07:25
Try setting calculation to manual in addition to screenupdating and events, but it may not get much faster. – Tim Williams Oct 30 '19 at 14:55
I tried it that way itself. But it took 137 sec for a small table only. the time was the same for my code and this simplified code @Tim Williams – Rick21 Oct 30 '19 at 15:12

Coloring cells that have dependents to other cells

1 Answers1