Consulting

Results 1 to 6 of 6

Thread: Make code more efficient

  1. #1
    VBAX Tutor
    Joined
    Jan 2006
    Posts
    248
    Location

    Make code more efficient

    I have the below code which works fine but is a bit slow, just wondering if it could be made more efficient to speed up the process.

    Sub Offset()Application.ScreenUpdating = False
    Dim r As Range
        Dim a As Range
        Set r = ActiveSheet.Range("C5:C1372")
        For Each a In r
            If a.Value = "WIC" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
        
       If a.Value = "WTC" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "AL" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "CDW" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
               
            If a.Value = "INJ" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "Sick" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "CL" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
           
            
            If a.Value = "TW" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            If a.Value = "JC" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "LSL" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            If a.Value = "WO" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            If a.Value = "2PJ" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "AJQ" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            If a.Value = "HFG" Then
                a.Offset(, -1) = a.Value
                a.Value = ""
               
            End If
            
            
            
            Next
            
            LR = Cells(Rows.Count, 17).End(xlUp).Row
    
    
    
    
    Application.ScreenUpdating = True
    
    
    
    
    
    
    End Sub
    Thanks for any assistance.

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Use arrays and Select Case.

  3. #3
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Using an explicitm yet dynamic, range will be faster
    Using a Select Case or an If...Then...ElseIf will cut the time in about half
    Using an If InStr will be even faster
    Using Arrays will be fastest yet.

    Dim CheckStr As String
    Dim r As Range
    Dim a As Range
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    CheckStr = "HFG, AJQ, 2PJ, etc"
    Set r = ActiveSheet.Range(Range("C5"), Cells(Rows.Count, "C").End(xlUp))")
       
        For Each a In r
            If Cbool(Instr(CheckStr, a) Then
                a.Offset(, -1) = a.Value
                a.Value = ""
            End If
        Next
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    End Sub
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Array approach

    Sub M_snb()
      sn = columns(5).specialcells(2).offset(4).specialcells(2).offset(,-1).resize(,2)
    
      for j=1 to ubound(sn)
        if instr(" HFG AJQ 2PJ ", " " & sn(j,2) & " ") then
           sn(j,1)=sn(j,2)
           sn(j,2)=""
        end if
      next
    
      columns(5),specialcells(2).offset(4).specialcells(2).offset(,-1).resize(,2)=sn
    end sub

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    All those If/Then's still get tested even if you find "WIC", etc.

    For something like this which runs in microseconds, I'd opt for making the code 'man readable' as much as possible

    Premature Optimization.jpg

    Option Explicit
    
    
    Sub Offset()
        Application.ScreenUpdating = False
        Dim r As Range
        Dim a As Range
        
        Set r = ActiveSheet.Range("C5:C1372")
        
        For Each a In r
            With a
                Select Case .Value
                    Case "WIC", "WTC", "AL", "CDW", "INJ", "Sick", "CL", "TW", "JC", "LSL", "WO", "2PJ", "AJQ", "HFG"
                        .Offset(, -1) = .Value
                        .Clear
                End Select
            End With
        Next
            
        Application.ScreenUpdating = True
    
    
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Tutor
    Joined
    Jan 2006
    Posts
    248
    Location
    Thank you for your replies Snb, SamT & Paul_Hossler, I have tested the 3 codes and they work fine and as I was aiming for and have provided a noticeable speed increase. thank you very much for your assistance and I will mark this thread as solved.

Posting Permissions

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