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]

Is this the sub?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

It is briefly running code every time you change the selection and if its in the range, it would briefly run that code. I'm not sure the intent, but would you rather it it do it to run the code only when a cell is changed rather than when the selection changes?

If so, then move the code to here....

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

 

[andrewb90]

Yes, It is a Selection Change code, which is what I want. I just don't get why it would have caused such a slow down.

 

[andrewb90]

Here is the entire code if that helps:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'Line Highlighting Tool
    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
    
    Range("G29:N35").Interior.Color = xlNone
    Range("G29:N35").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G29:N35"))
    If Not S Is Nothing Then
        Range("G" & Target.Row & ":N" & Target.Row).Interior.ColorIndex = 6  'Yellow
        Range("G" & Target.Row & ":N" & Target.Row).Font.Bold = True
    End If
    
    Range("G36:M38").Interior.Color = xlNone
    Range("G36:M38").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G36:M38"))
    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
    
    Range("G39:N41").Interior.Color = xlNone
    Range("G39:N41").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G39:N41"))
    If Not S Is Nothing Then
        Range("G" & Target.Row & ":N" & Target.Row).Interior.ColorIndex = 6  'Yellow
        Range("G" & Target.Row & ":N" & Target.Row).Font.Bold = True
    End If
    
    Range("G42:M43").Interior.Color = xlNone
    Range("G42:M43").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G42:M43"))
    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
    
    Range("G45:M77").Interior.Color = xlNone
    Range("G45:M77").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G45:M77"))
    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
    
    Range("G79:M86").Interior.Color = xlNone
    Range("G79:M86").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G79:M86"))
    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
    
    Range("G88:M102").Interior.Color = xlNone
    Range("G88:M102").Font.Bold = False
    Set S = Application.Intersect(Range(Target.Address), Range("G88:M102"))
    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
End Sub

 

[andrewb90]

Any ideas out there?

 

[rjwebgraphix]

You are running code, so it is going to pause while it runs the code. You might be able to speed the code up a little by disabling screen updating while it runs the code.

At the start of the code:

Application.ScreenUpdating = False

Just be sure turn it back on at the end of the code:

Application.ScreenUpdating = True

Although it will still run the code whenever making selection changes. Running code is what slows it. It's not a flaw in the code.... It is running the code. There's not much you can do about it. The only thing you can do is run the code on another event rather than on selection change. Then your selection changes go back to normal and when the code runs it is more controlled.

Edit:

As an afterthought. You could try setting it up so it runs as little code as possible too...
It didn't make much of a difference on this end. From what I can tell, the amount of pause is practically insignificant. Here's what I did.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
    'Line Highlighting Tool

    Set s = Application.Intersect(Range(Target.Address), _
        Range("G18:M28,G29:N35,G36:M38,G39:N41,G42:M43,G45:M77,G79:M86,G88:M102"))
    If Not s Is Nothing Then
        Range("G18:M28").Interior.Color = xlNone
        Range("G18:M28").Font.Bold = False
        If Target.row >= 18 And Target.row <= 28 Then
            
            Range("G" & Target.row & ":M" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":M" & Target.row).Font.Bold = True
        End If
        Range("G29:N35").Interior.Color = xlNone
        Range("G29:N35").Font.Bold = False
        If Target.row >= 29 And Target.row <= 35 Then
            Range("G" & Target.row & ":N" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":N" & Target.row).Font.Bold = True
        End If
        Range("G36:M38").Interior.Color = xlNone
        Range("G36:M38").Font.Bold = False
        If Target.row >= 36 And Target.row <= 38 Then
            Range("G" & Target.row & ":M" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":M" & Target.row).Font.Bold = True
        End If
        Range("G39:N41").Interior.Color = xlNone
        Range("G39:N41").Font.Bold = False
        If Target.row >= 39 And Target.row <= 41 Then
            Range("G" & Target.row & ":N" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":N" & Target.row).Font.Bold = True
        End If
        Range("G42:M43").Interior.Color = xlNone
        Range("G42:M43").Font.Bold = False
        If Target.row >= 42 And Target.row <= 43 Then
            Range("G" & Target.row & ":M" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":M" & Target.row).Font.Bold = True
        End If
        Range("G45:M77").Interior.Color = xlNone
        Range("G45:M77").Font.Bold = False
        If Target.row >= 45 And Target.row <= 77 Then
            Range("G" & Target.row & ":M" & Target.row).Interior.ColorIndex = 6 'Yellow
            Range("G" & Target.row & ":M" & Target.row).Font.Bold = True
        End If
        Range("G79:M86").Interior.Color = xlNone
        Range("G79:M86").Font.Bold = False
        If Target.row >= 79 And Target.row <= 86 Then
            Range("G" & Target.row & ":M" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":M" & Target.row).Font.Bold = True
        End If
        Range("G88:M102").Interior.Color = xlNone
        Range("G88:M102").Font.Bold = False
        If Target.row >= 88 And Target.row <= 102 Then
            Range("G" & Target.row & ":M" & Target.row).Interior.ColorIndex = 6  'Yellow
            Range("G" & Target.row & ":M" & Target.row).Font.Bold = True
        End If
    End If

Application.ScreenUpdating = True
End Sub

This will, however, leave one highlighted row if you are outside of the range, but it also bypasses everything if you are outside the range.

 

[ukmikeb]

Hi

It strikes me that you could be doing a lot of processing for nothing!

Are you sure that you want to clear the background colour and Bold Font if the Target doesn't intersect with the Range/s?


You could reduce the range allocation with the following :-

With Range("G18:M28")
    .Interior.Color = xlNone
    .Font.Bold = False
End With

"S" is a range by definition so why do you have :-

        Range("G" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6  'Yellow
        Range("G" & Target.Row & ":M" & Target.Row).Font.Bold = True

which can be better expressed with :-

With S
     .Interior.ColorIndex = 6  'Yellow
     .Font.Bold = True
End With

Also, "Range("G" & Target.Row & ":M" & Target.Row)" implies a single cell selection, so what happens if a range is selected?

You might be able to get away with the following:-

Dim NewRange as Range
Dim S as Range

Application.EnableEvents = False
Set NewRange = Application.Union(Range("G18:M102"), Range("N29:N35"), Range("N39:N41"))
With NewRange
    .Interior.Color = xlNone
    .Font.Bold = False
End With
    Set S = Application.Intersect(Target, NewRange)
    If Not S Is Nothing Then
        With S
                 .Interior.ColorIndex = 6  'Yellow
                 .Font.Bold = True
        End With
   End If
Application.EnableEvents = True

hth

 

[rjwebgraphix]

"S" is a range by definition ...

S is the individual cell range, whereas he needs the whole range....

Range("G" & Target.Row & ":M" & Target.Row).Interior.ColorIndex = 6 'Yellow

To Highlight in yellow that range (row) when any cell within the range are selected. There might be something to your shortened version if it can be adapted to the whole range.
</pre>

 

[ukmikeb]

Hi Andrew

The code below will clear any previous areas of highlighting and set highlighting on the intersect row to the column limits for the particular area :-

Dim NewRange As Range
Dim Cell As Range
Dim S As Range
Dim AdArray(), RwArray(), UsArray(), WdArray()
Dim I As Long, Ps
RwArray = Array(18, 29, 36, 39, 42, 44, 45, 78, 79, 87, 88, 103)
WdArray = Array(0, 7, 8, 7, 8, 7, 0, 7, 0, 7, 0, 7, 0)
AdArray = Array(, "$G$18:$M$28", "G29:N35", "G36:M38", "G39:N41", "G42:M43", "G44:M44", "G45:M77", "G78:M78", "G79:M86", "G87:M87", "G88:M102")
UsArray = Array(0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1)

Application.EnableEvents = False

Set NewRange = Range(AdArray(1))
For I = 2 To UBound(UsArray, 1)
    If UsArray(I) Then
'    Add Ranges according to a 1 setting in UsArray
        Set NewRange = Application.Union(NewRange, Range(AdArray(I)))
    End If
 Next I
 
 Set S = Intersect(Target, NewRange)
 
 If Not S Is Nothing Then
 
     For Each Cell In Range("G18:G" & RwArray(UBound(RwArray, 1)) - 1)
'        Clear all previously highlighted rows
        If Cell.Interior.ColorIndex = 6 Then
            Ps = Application.WorksheetFunction.match(Cell.Row, RwArray, 1)
            With Cell.Resize(1, WdArray(Ps))
                 .Interior.ColorIndex = None
                 .Font.Bold = False
            End With
      End If
   Next Cell
'  Find the position of the Intersect Row in the Row Array
Ps = Application.WorksheetFunction.match(S.Row, RwArray, 1)
    
    With Range("G" & S.Row).Resize(1, WdArray(Ps))
'    Fill in/Bold Font the Intersect Row for the correct number of columns
        .Interior.ColorIndex = 6
        .Font.Bold = True
    End With
End If
Application.EnableEvents = True

Hopefully it will run a lot faster than your current method.

If you have any questions , please get back to me.

hth

 

[andrewb90]

Hi Mike,

I think i like your new code so far, however I need a little direction, as my attempts to change some of the ranges have been met with issues. If I need to both add and change the ranges listed, what else do I need to change besides the AdArray?

Thanks,

Andrew