Results 1 to 5 of 5

Thread: speed up code?
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Jan 2017
    Posts
    455
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default speed up code?

    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.
    Thank you.
    Orbis non sufficit

    Trevor3007

  2. #2
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,405
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: speed up code?

    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 by Michael M; Jun 18th, 2019 at 03:14 AM.
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  3. #3
    Board Regular
    Join Date
    Jan 2017
    Posts
    455
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: speed up code?

    Quote Originally Posted by Michael M View Post
    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 by Trevor3007; Jun 18th, 2019 at 03:40 PM.
    Thank you.
    Orbis non sufficit

    Trevor3007

  4. #4
    MrExcel MVP
    Junior Admin
    Joe4's Avatar
    Join Date
    Aug 2002
    Posts
    49,667
    Post Thanks / Like
    Mentioned
    51 Post(s)
    Tagged
    11 Thread(s)

    Default Re: speed up code?

    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?
    TIPS FOR FINDING EXCEL SOLUTIONS
    1. Use the built-in Help that comes with Excel/Access
    2. Use the Search functionality on this board
    3. A lot of VBA code can be acquired by using the Macro Recorder.

    "Give a man a fish, feed him for a day. Teach a man to fish, feed him for life!"

  5. #5
    Board Regular
    Join Date
    Jan 2017
    Posts
    455
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: speed up code?

    Quote Originally Posted by Joe4 View Post
    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
    Thank you.
    Orbis non sufficit

    Trevor3007

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •