speed up code?

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
514
good morning ,

Code:
Private Sub Worksheet_Change(ByVal Target As Range)    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Target.Count > 1000 Then Exit Sub
        For Each c In Target
            If LCase(c.Offset(0, 1).Value) = LCase("Matched Assets") Then
                Range("A" & c.Row & ":k" & c.Row).Interior.ColorIndex = 24
            Else
                Range("A" & c.Row & ":k" & c.Row).Interior.ColorIndex = xlNone
            End If
        Next
    End If
    
    


If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("l3:l8000")) Is Nothing Then


        Application.EnableEvents = False


        Target = UCase(Target)


        Application.EnableEvents = True
    End If
      


    On Error GoTo 0




If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub






    On Error Resume Next


    If Not Intersect(Target, Range("A3:h8000")) Is Nothing Then


        Application.EnableEvents = False


        Target = UCase(Target)


        Application.EnableEvents = True
    End If
      


    On Error GoTo 0




If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub




    On Error Resume Next


    If Not Intersect(Target, Range("13:i8000")) Is Nothing Then


        Application.EnableEvents = False


        Target = StrConv(Target, vbProperCase)


        Application.EnableEvents = True
        
        Range("A3:L8000").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
End With
End If
      
       
       
      
   
End Sub

The code above works, but it runs like a 3 legged dog! Is there a way to speed up?

MTIA & hope you have a good day.
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
18,872
Office Version
2013
Platform
Windows
I haven't looked through the code, but try UNTESTED
AND
can you combine the Ucase statements ??
Is row 8000 the true end of the data or did you just plug in an arbitary number ??
What does this refer to
LCase("Matched Assets")
, a range or an entire sheet ??


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
If Target.Count > 1000 Then Exit Sub
        For Each c In Target
            If LCase(c.Offset(0, 1).Value) = LCase("Matched Assets") Then
                Range("A" & c.Row & ":k" & c.Row).Interior.ColorIndex = 24
            Else
                Range("A" & c.Row & ":k" & c.Row).Interior.ColorIndex = xlNone
            End If
        Next
    End If
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("l3:l8000")) Is Nothing Then
        Target = UCase(Target)
    End If
    On Error GoTo 0
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("A3:h8000")) Is Nothing Then
        Target = UCase(Target)
    End If
    On Error GoTo 0
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("13:i8000")) Is Nothing Then
        Target = StrConv(Target, vbProperCase)
        
    With Range("A3:L8000").Font
        .Name = "Calibri"
        .Size = 20
        .ThemeColor = xlThemeColorLight1
        .ThemeFont = xlThemeFontMinor
End With
End If
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub
 
Last edited:

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
514
I haven't looked through the code, but try UNTESTED
AND
can you combine the Ucase statements ??
Is row 8000 the true end of the data or did you just plug in an arbitary number ??
What does this refer to , a range or an entire sheet ??


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
If Target.Count > 1000 Then Exit Sub
        For Each c In Target
            If LCase(c.Offset(0, 1).Value) = LCase("Matched Assets") Then
                Range("A" & c.Row & ":k" & c.Row).Interior.ColorIndex = 24
            Else
                Range("A" & c.Row & ":k" & c.Row).Interior.ColorIndex = xlNone
            End If
        Next
    End If
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("l3:l8000")) Is Nothing Then
        Target = UCase(Target)
    End If
    On Error GoTo 0
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("A3:h8000")) Is Nothing Then
        Target = UCase(Target)
    End If
    On Error GoTo 0
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    If Not Intersect(Target, Range("13:i8000")) Is Nothing Then
        Target = StrConv(Target, vbProperCase)
        
    With Range("A3:L8000").Font
        .Name = "Calibri"
        .Size = 20
        .ThemeColor = xlThemeColorLight1
        .ThemeFont = xlThemeFontMinor
End With
End If
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub
hello Michael M,

many thanks for your reply. Sadly, 8000 is the last row. Your 'can you combine the Ucase statements' ? anything to assist the speed will be great.
 
Last edited:

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,410
Office Version
365
Platform
Windows
Unfortunetlly 8000 is the last row
Why is that unfortunate? I think he was going to offer to find the last row dynamically, but if that is not necessary, then the code can be shorter.

Did you try out the code he gave you?
Did it help?
 

Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
514
Why is that unfortunate? I think he was going to offer to find the last row dynamically, but if that is not necessary, then the code can be shorter.

Did you try out the code he gave you?
Did it help?
i have not tried as I dont have the workbook with me ATM.

thank you for your reply too BTW
 

Watch MrExcel Video

Forum statistics

Threads
1,099,018
Messages
5,466,073
Members
406,463
Latest member
vstruggs

This Week's Hot Topics

Top