Trevor3007

Well-known Member
Joined
Jan 26, 2017
Messages
667
Office Version
  1. 365
Platform
  1. Windows
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.
 

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.
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:
Upvote 0
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:
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,956
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top