Slow VBA/Excel Problems

[jhedges]

I have the following code inserted via right-clicking on the sheet tab and then clicking on view code:

1 - to color cell A based upon what happens with the data entry within that row.
2 - to insert as new row based upon a double click of the last entry in the spreadsheet.
3 - to provide calendar functionality to the spreadsheet.

The spreadhseet is password protected to prevent any changes to the formulas by the users entering the data. I had to add the ActiveSheet.Unprotect Password/ActiveSheet.Protect Password to allow the code to work. I first tried to put the code at the beginning and at the end of each code segment; however, that didn't work. With how the code is set now everything works. There seems to be too many Unprotect/Protect lines...

My problems are that it seems to take along time for the code to insert a new row after you double click on the last entry. Does anyone see a way to consolidate the code to improve the operation of the spreadsheet?

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlManual
ActiveSheet.Unprotect Password:="aaa"
Dim Cell As Range
Dim Rng1 As Range
    On Error Resume Next
    Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    If Rng1 Is Nothing Then
        Set Rng1 = Range(Target.Address)
        Else
        Set Rng1 = Union(Range(Target.Address), Rng1)
    End If
    For Each Cell In Rng1
        Select Case Cell.Value
            Case vbNullString
                Cell.Interior.ColorIndex = xlNone
                Cell.Font.ColorIndex = xlNone
                Cell.Font.Bold = False
            Case "ACTIVE"
                Cell.Interior.ColorIndex = 10
                Cell.Font.ColorIndex = 2
                Cell.Font.Bold = True
            Case "EXPIRED"
                Cell.Interior.ColorIndex = 1
                Cell.Font.ColorIndex = 2
                Cell.Font.Bold = True
            Case "NEW MEMBER"
                Cell.Interior.ColorIndex = xlNone
                Cell.Font.ColorIndex = 1
                Cell.Font.Bold = True
            Case "Session 1 Past Due", "Session 2 Past Due", "Session 3 Past Due", "Session 4 Past Due"
                Cell.Interior.ColorIndex = 3
                Cell.Font.ColorIndex = 2
                Cell.Font.Bold = True
            Case Else
                Cell.Interior.ColorIndex = xlNone
                Cell.Font.ColorIndex = xlNone
                Cell.Font.Bold = False
        End Select
    Next
Application.Calculation = xlAutomatic
ActiveSheet.Protect Password:="aaa"
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True   'Eliminate Edit status due to doubleclick
ActiveSheet.Unprotect Password:="aaa"
    Target.Offset(1).EntireRow.Insert
ActiveSheet.Unprotect Password:="aaa"
    Target.EntireRow.Copy Target.Offset(1).EntireRow
    On Error Resume Next
ActiveSheet.Unprotect Password:="aaa"
    Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
    On Error GoTo 0
ActiveSheet.Protect Password:="aaa"
End Sub
Private Sub Calendar1_Click()
ActiveSheet.Unprotect Password:="aaa"
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveSheet.Unprotect Password:="aaa"
ActiveCell.NumberFormat = "m/dd/yyyy"
ActiveCell.Select
Calendar1.Visible = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("F4:F200,J4:J200,K4:K200,L4:L200,M4:M200"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
ActiveSheet.Protect Password:="aaa"
End If
End Sub

 

[ActuaryGuy123]

I think I know what the problem is: The WorksheetChange event macro is probably getting called multiple times with each time you insert a row or any other macros are called. Check with a breakpoint.

If so, you could add Application.EnableEvents = False at the beginning of the other Subs and set it back to true at the end of each sub.

 

[jbeaucaire]

I'd also suggest that you use conditional Formatting on your formula cells to turn off/on the bolding, that sheet level formatting change applied to EVERY cell with a formula EVERY TIME you make any change anywhere is performance dragging.

Further, I'd rethink the whole process. Surely there has to be a way to logically limit how many cells are being "checked" with each change on the sheet. Typically, a change I make on row10 would change the calculations in other cells on Row10 thus I could limit the cells to check for that moment to just the formula cells on row10. Would that be possible? If so, huge performance boost.

 

[jhedges]

Thank you! The Application.EnableEvents coding work great.

JHedges

 

[ActuaryGuy123]

No prob!