speed up code?

[Trevor3007]

good morning ,

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.

 

[Michael M]

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 ??

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

 

[Trevor3007]

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 ??

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.

 

[Joe4]

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]

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