VBA optimisation

[jrgsea]

Hi there,

I have created an excel spreadsheet with some fairly extensive VBA code (for my standards anyway), and it seems there are some significant propagation delays. I believe the biggest delay is stemming from a range of cells that have a timestamp recorded when data is entered into the cell. Could one of you talented folk help me minimize any delays?

FYI: It takes about 8 seconds for the timestamp to be recorded.

Thanks!

Josh.

 

[Smitty]

Welcome to the Board!

You'd need to post the code in question.

 

[jrgsea]

Here you go, Smitty. I think you might have helped me with this actually!

' Code goes in the Worksheet specific module
Dim rng As Range
' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
Set rng = Target.Parent.Range("N32:N46, P32:P46, R32:R46")
' Only look at single cell changes
If Target.Count > 1 Then Exit Sub
' Only look at that range
If Intersect(Target, rng) Is Nothing Then Exit Sub
' Action if Condition(s) are met (do your thing here...)
Target.Offset(, -1) = Now

 

[Smitty]

You might want to turn off Calculation:

Application.Calculation = xlCalculationManual
Target.Offset(, -1) = Now
Application.Calculation = xlCalculationAutomatic

And possibly events if you have other events that are triggered as a result of the change event.

 

[jrgsea]

Hmm that didn't make much difference. I'm running a very long script; could this be the issue? Is there anyway of shortening the scripts? Possibly having multiple to be activated when required?

I'll post the script below. (Don't be frightened!)

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Me.Unprotect ("js")
    
    If Range("G37").Value = 0 Then
        Rows("37").EntireRow.Hidden = True
    Else
        Rows("37").EntireRow.Hidden = False
    End If
    
    If Range("G38").Value = 0 Then
        Rows("38").EntireRow.Hidden = True
    Else
        Rows("38").EntireRow.Hidden = False
    End If
    
    If Range("G39").Value = 0 Then
        Rows("39").EntireRow.Hidden = True
    Else
        Rows("39").EntireRow.Hidden = False
    End If
    
    If Range("G40").Value = 0 Then
        Rows("40").EntireRow.Hidden = True
    Else
        Rows("40").EntireRow.Hidden = False
    End If
    
    If Range("G41").Value = 0 Then
        Rows("41").EntireRow.Hidden = True
    Else
        Rows("41").EntireRow.Hidden = False
    End If
    
    If Range("G42").Value = 0 Then
        Rows("42").EntireRow.Hidden = True
    Else
        Rows("42").EntireRow.Hidden = False
    End If
    
    If Range("G43").Value = 0 Then
        Rows("43").EntireRow.Hidden = True
    Else
        Rows("43").EntireRow.Hidden = False
    End If
    
    If Range("G44").Value = 0 Then
        Rows("44").EntireRow.Hidden = True
    Else
        Rows("44").EntireRow.Hidden = False
    End If
    
    If Range("G45").Value = 0 Then
        Rows("45").EntireRow.Hidden = True
    Else
        Rows("45").EntireRow.Hidden = False
    End If
    
    If Range("G46").Value = 0 Then
        Rows("46").EntireRow.Hidden = True
    Else
        Rows("46").EntireRow.Hidden = False
    End If
    
    If Range("ProductionRun").Value = "Summary" Then
        Rows("37:46").EntireRow.Hidden = False
    End If
    
    Me.Protect ("js")
    
    Select Case ActiveSheet.Range("ProductionRun")
    Case "1"
        With ActiveSheet
            .Unprotect ("js")
            .Range("ProdSummary").Locked = True
            .Range("ProdRun1").Locked = False
            .Protect ("js")
        End With
    
    '   Code goes in the Worksheet specific module
    Dim rng As Range
    '   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
        Set rng = Target.Parent.Range("N32:N46")
        '   Only look at single cell changes
            If Target.Count > 1 Then Exit Sub
        '   Only look at that range
            If Intersect(Target, rng) Is Nothing Then Exit Sub
        '   Action if Condition(s) are met (do your thing here...)
            Target.Offset(, -1) = Now
    
    Case "2"
        With ActiveSheet
            .Unprotect ("js")
            .Range("ProdSummary").Locked = True
            .Range("ProdRun2").Locked = False
            .Protect ("js")
        End With
    
    '   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
        Set rng = Target.Parent.Range("P32:P46")
        '   Only look at single cell changes
            If Target.Count > 1 Then Exit Sub
        '   Only look at that range
            If Intersect(Target, rng) Is Nothing Then Exit Sub
        '   Action if Condition(s) are met (do your thing here...)
            Target.Offset(, -1) = Now
    
    Case "3"
        With ActiveSheet
            .Unprotect ("js")
            .Range("ProdSummary").Locked = True
            .Range("ProdRun3").Locked = False
            .Protect ("js")
        End With
    
    '   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
        Set rng = Target.Parent.Range("R32:R46")
        '   Only look at single cell changes
            If Target.Count > 1 Then Exit Sub
        '   Only look at that range
            If Intersect(Target, rng) Is Nothing Then Exit Sub
        '   Action if Condition(s) are met (do your thing here...)
            Target.Offset(, -1) = Now
    
    Case "Summary"
        With ActiveSheet
            .Unprotect ("js")
            .Range("ProdSummary").Locked = True
            .Protect ("js")
        End With
    End Select
    
End Sub

 

[Smitty]

For the first part where you're hiding rows, I'd probably go with AutoFilter to hide 0 values. Otherwise a loop will be more efficient.