Selection change VBA has slowed Excel

[andrewb90]

Hello all,

I have this code in place:

    Range("G18:M28").Interior.Color = xlNone    Range("G18:M28").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G18:M28"))
    If Not S Is Nothing Then
        Range("G" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
        Range("G" & Target.Row & ":M" & Target.Row).Font.Bold = True
    End If

Now, I have several more areas of the sheet where the same thing applies as well (just different ranges). I just added the bold font line, and now every time I click in a cell in the range, I see my mouse turning as it loads (briefly, less than half a second), but I am not sure why there is a lag. I can't really think that doing this little would cause excel to slow down, so I'm at a loss. I can send the entire code as I currently have it, if that would help.

One other point to mention, is when I added the bold font to just one of the ranges, I had no trouble, when I did it to all 8 (will have 14 sections total), that is when I found a lag in the response.
Any thoughts would be greatly appreciated!

Andrew

 

[rjwebgraphix]

The second is that now the code runs even slower than before.

I still say that no matter how you change the code, you are still running code when the selection changes. So, you will have that fraction of a second pause every time you do a selection change. There is no way around it other than running as little code as possible to get the job done, but even with that it will still pause for that fraction of a second. On my system, which I think is slow as dirt, that amount of time was not much at all for running any kind of code, even on your original code.

Just my 2 cents worth.

 

[ZVI]

Hi,
Try this speed optimized:

Option Explicit
Const MyAreas = "G1:M23,G24:N30,G31:M33,G34:N36,G37:M38"
Dim a, MyCol As Collection, Rng As Range, x As Range
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If MyCol Is Nothing Then
    ' Setup MyCol only once first time
    Set MyCol = New Collection
    For Each a In Split(MyAreas, ",")
      MyCol.Add Range(a)
    Next
  End If
  If Not x Is Nothing Then
    ' Clear previous highlighting
    With x
      .Interior.Color = xlNone
      .Font.Bold = False
    End With
  End If
  For Each x In MyCol
    ' Check intersection
    Set Rng = Intersect(Target, x)
    If Not Rng Is Nothing Then Exit For
  Next
  If Not x Is Nothing Then
    ' Highlight row
    Set x = x.Rows(Rng.Row - x.Row + 1)
    With x
      .Interior.Color = vbYellow
      .Font.Bold = True
    End With
  End If
End Sub

Regards

 

[ZVI]

Below is the updated code.
Modifications:
1. CutCopyMode suspends highlighting.
2. Each area is cleared from highlighting for the first time. For the case workbook was saved with highlighting and then reloaded.
3. Misprinted Color is replaced by ColorIndex

Option Explicit
Const MyAreas = "G1:M23,G24:N30,G31:M33,G34:N36,G37:M38"
Dim a, MyCol As Collection, Rng As Range, x As Range
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Application.CutCopyMode Then Exit Sub
  If MyCol Is Nothing Then
    ' Setup MyCol only once first time
    Set MyCol = New Collection
    For Each a In Split(MyAreas, ",")
      MyCol.Add Range(a)
      ' Clear highligtings in each area for the first time
      Application.ScreenUpdating = False
      With Range(a)
        .Interior.ColorIndex = xlNone
        .Font.Bold = False
      End With
      Application.ScreenUpdating = True
    Next
  End If
  If Not x Is Nothing Then
    ' Clear previous highlighting
    With x
      .Interior.ColorIndex = xlNone
      .Font.Bold = False
    End With
  End If
  For Each x In MyCol
    ' Check intersection
    Set Rng = Intersect(Target, x)
    If Not Rng Is Nothing Then Exit For
  Next
  If Not x Is Nothing Then
    ' Highlight row
    Set x = x.Rows(Rng.Row - x.Row + 1)
    With x
      .Interior.Color = vbYellow
      .Font.Bold = True
    End With
  End If
End Sub

 

[ZVI]

After some testing:
to prevent blinking after reloading of workbook (see p.2 in previous post#23) delete those lines of code:
Application.ScreenUpdating = False
Application.ScreenUpdating = True

 

[ukmikeb]

Hi

@andrewb90 Apologies that I hadn't interpreted that any previous highlighting would be cancelled when a selection was made outside the specified ranges.

The code didn't run slowly for me. Must be taking my clocked Intel Core i5 for granted.

Vladimirs' code belies his wealth of experience in Excel and I suggest you go with that for a faster execution.

Pleased to have helped you along the way.

Good luck with your project.

@ZVI
Vladimir Thanks for providing a different slant on my code and expanding my knowledge accordingly.

I notice that you have removed the "Application.ScreenpUpdating ..." statements but would ask whether they would have been better applied outside the loop "to remove any previous highlighting" than within it?

 

[ZVI]

I notice that you have removed the "Application.ScreenpUpdating ..." statements but would ask whether they would have been better applied outside the loop "to remove any previous highlighting" than within it?

Hi Mike,

Ugh, it was stupid place for Application.ScreenUpdating in my code! Debugging trash.
You definitely correct, their good places are outside For-Next loop.
But in my testing they are not required at all. It's known also that Application.ScreenUpdating = True forces recalculating of all CF formulas in visible range of the window, slow repaints the shapes especially those are shadowed, thus it can cause visible blinking.

BTW, on my PC there was no visual speed problem with any code of this thread.
May be there are a lot of CFs/Shapes or not 100% zoom or just wide screen is used on Andrew’s PC, This can be also Excel 2013 with its relatively slow animation of the cursor moving.

Kind Regards,
Vlad

 

[andrewb90]

Hi Vlad,

I appreciate the updated code. It seems to work quite well, however I have one question about it. I have a frozen row on my worksheet and it contains several shapes that have macros attached to them. I notice that they flash when the code runs, is there any way around this?

Thanks,

Andrew

 

[ZVI]

Hi Andrew,

It is behavior of Excel 2007+ versions.

I would suggest using of Conditional Formatting instead:

Option Explicit
Const MyAreas = "G1:M23,G24:N30,G31:M33,G34:N36,G37:M38"
Dim a, MyCol As Collection, Rng As Range, x As Range
 
' Highlighting with Conditional Formatting
' Warning: it deletes all conditional formats in MyAreas ranges!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim i As Long
  If Application.CutCopyMode Then Exit Sub
  If MyCol Is Nothing Then
    ' Setup MyCol only once first time
    Set MyCol = New Collection
    For Each a In Split(MyAreas, ",")
      MyCol.Add Range(a)
      ' Clear CF highligtings in each area for the first time
      Range(a).FormatConditions.Delete
    Next
  End If
  If Not x Is Nothing Then
    ' Clear the previous CF highlighting
    x.FormatConditions.Delete
  End If
  For Each x In MyCol
    ' Check intersection
    Set Rng = Intersect(Target, x)
    If Not Rng Is Nothing Then Exit For
  Next
  If Not x Is Nothing Then
    ' Highlight row of MyAreas via CF
    i = ActiveCell.Interior.ColorIndex
    Set x = x.Rows(Rng.Row - x.Row + 1)
    With x.FormatConditions.Add(Type:=2, Formula1:=1)
      .Interior.ColorIndex = IIf(i < 0, 6, i + 1)
      .Font.Bold = True
    End With
  End If
End Sub

Kind Regards,
Vlad

 

[andrewb90]

Wow! You are amazing! Thanks so much!!!

 

[ZVI]

Glad we shot down that blinking!