Results 1 to 6 of 6

Slow running Code

Threaded View

  1. #1
    Registered User
    Join Date
    05-24-2015
    Location
    Sydney, Australia
    MS-Off Ver
    2007
    Posts
    3

    Slow running Code

    Hello all,
    As I am sure you'll notice from the clunky code I am self taught and hoping that is why this is running so slowly. The code is doing exactly what I want it to but is taking a long time (~15 to 20 seconds) to run. The basic idea is that users use the filters on the source data tab to identify a set of rows they want to classify, they then use a user form to classify and it is copy and pasted on to an allocations tab.

    Any ideas of how I can make this run quicker?

    Thank you!!!

    Sub CopyPartOfFilteredRange()
        Dim src As Worksheet
        Dim tgt As Worksheet
        Dim filterRange As Range
        Dim copyRange As Range
        Dim lastRow As Long
        Dim lastRow2 As Long
        Dim lastRow3 As Long
        Dim cell As Range
        
        Set src = ThisWorkbook.Sheets("Source_Data")
        Set tgt = ThisWorkbook.Sheets("Allocations")
               
           
        Application.ScreenUpdating = False
        
        '100% button
        If ToggleButton_100 = True Then
            TextBox_Allocation.Value = 100
            
        End If
            
        'checks
            If TextBox_Allocation.Value = "" And ToogleButton_100 = False Then
                MsgBox "You must enter an allocation amount"
                
            ElseIf TextBox_Allocation.Value > 100 Then
                MsgBox "The max allocation is 100%"
                
            ElseIf ActiveSheet.Name = "Allocations" Then
                MsgBox "Allocations relate to filtered rows on Source_Data tab ONLY"
            
            Else
        
        'removes filters from Allocations tab
        Application.Goto tgt.Range("C3")
        If (tgt.AutoFilterMode And tgt.FilterMode) Or tgt.FilterMode Then
                 tgt.ShowAllData
        End If
            
        ' find the last row with data in column Source_Data Ref
        lastRow = src.Range("D" & src.Rows.Count).End(xlUp).Row
        
        ' find the last row with data in column Sheet 2 Ref
        lastRow2 = tgt.Range("C" & tgt.Rows.Count).End(xlUp).Row
    
        ' the range that we are auto-filtering (all columns)
        Set filterRange = src.Range("B2:M" & lastRow)
    
        ' the range we want to copy (only columns we want to copy)
        ' we set the range to start in row 3 to prevent copying the header
        Set copyRange = src.Range("D3:M" & lastRow)
        
        ' filter range Exclusions based on column B <> "Yes"
        Application.Goto src.Range("D3")
        filterRange.AutoFilter field:=1, Criteria1:=""
           
        ' copy the visible cells to tgt ranges last row
        copyRange.SpecialCells(xlCellTypeVisible).Copy
        tgt.Range("C" & lastRow2 + 1).PasteSpecial (xlPasteValues)
        
        'last row following of tgt sheet following posting
        lastRow3 = tgt.Range("C" & tgt.Rows.Count).End(xlUp).Row
            
        'transfer data from userform
        tgt.Range("M" & lastRow2 + 1 & ":M" & lastRow3).Value = ListBox_Group.Value
        tgt.Range("N" & lastRow2 + 1 & ":N" & lastRow3).Value = ListBox_Sub.Value
        tgt.Range("O" & lastRow2 + 1 & ":O" & lastRow3).Value = ListBox_SubSplit.Value
        tgt.Range("P" & lastRow2 + 1 & ":P" & lastRow3).Value = ListBox_Plants.Value
        tgt.Range("Q" & lastRow2 + 1 & ":Q" & lastRow3).Value = TextBox_Allocation.Value / 100
        tgt.Range("R" & lastRow2 + 1 & ":R" & lastRow3).Value = TextBox_Notes.Value
        
        Call Clear_UserForm
        
        'copy sumif formula
        tgt.Range("B3:B" & lastRow3).Formula = "=SUMIF($C:$C,C3,$Q:$Q)"
         
        'resets Exclusion flags
        For Each cell In src.Range("B3:B" & lastRow)
            If Not Application.IsNumber(cell) Then cell.ClearContents
        Next cell
         
        AllocationUserForm.Hide
        
        Application.Goto src.Range("D3")
        If (src.AutoFilterMode And src.FilterMode) Or src.FilterMode Then
            src.ShowAllData
        End If
        
        Application.ScreenUpdating = True
        
      
    End If
    
    End Sub
    Last edited by Leith Ross; 05-24-2015 at 10:29 PM. Reason: Added Code Tags

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Slow running code
    By phil2006 in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 12-13-2013, 08:02 AM
  2. vba code running too slow
    By hitsujicute in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 03-31-2013, 06:00 PM
  3. VBA Code running very slow. Need help
    By krjoshi in forum Excel Programming / VBA / Macros
    Replies: 9
    Last Post: 03-21-2013, 02:13 PM
  4. Slow running code
    By Rick_Stanich in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 11-06-2008, 12:49 PM
  5. Code running slow
    By lou031205 in forum Excel Programming / VBA / Macros
    Replies: 10
    Last Post: 11-08-2007, 12:20 PM

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1