locked
Macro slow down-from 15 minutes to several hours. Upgrade 2010 to Excel 2013 RRS feed

  • Question

  • First: I do not know how to write macros. I need help to figure out what is causing this macro to go from about 15/20 run time to several hours run time. I don't have much support at work. Any help is much appreciated. Let me know what is needed.

    When I go into View > Macros for only this workbook, I see a laundry list.

    Let me know if anyone wants to take a stab and reviewing the code. Again, I do not know how to write macro's nor do I understand VBA. :(.

    Tuesday, September 1, 2015 10:19 PM

Answers

  • JZEPEDA,

      Without knowing what your data looks like on the "Raw Data" sheet, we can only make some general statements.

    1. Place the following at the top of the Sub MoveLaunch -

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating=False

    2. Place the following at the bottom of Sub MoveLaunch

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating=True

    3. The copy and pasting takes a lot of resources. Take a look at the following page to see how to copy data from

    on sheet to another. Look for "Avoid the use of Copy and Paste whenever Possible:" on the webpage Speeding up VBA

    Let us know if this helps.

    Harry






    Friday, September 4, 2015 6:39 PM
  • Hi JZEPEDA,

    To narrrow down this issue, I suggest that you insert the code to track the time cost to find which line of code caused this issue.

    In addition, can you reproduce this issue on a clean machine which installed Excel 2013? If not, I suggest that you repair or update the Excel application to the latest version.

    If yes, would you mind sharing the code that cause this issue?

    For example, you can use code below to track the time costing for the code:

    a = Time
    
    'code here
    Debug.Print DateDiff("s", a, Time)
    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, September 3, 2015 5:32 AM
  • Hi Julie,

    We can modify the code below to track the time costed by the specific sub:

    Sub MoveLaunch()
    'Launches all the subroutines to move data to the appropriate subsheets
    
        a = Time
        MoveASO
        
        'code here
        Debug.Print "Time costed for MoveAso sub: " & DateDiff("s", a, Time)
        a = Time
        MoveMux
        Debug.Print "Time costed for MoveMux sub: " & DateDiff("s", a, Time)
        
        MoveRF
        MoveBSO
        MoveBEM
        MoveSolar
        MoveBusMech
        MoveSubCon
        MoveRSO
        MoveBatt
        MoveSM
        MoveThermo
        ClearRawData
        
    End Sub

    Then you can compare the marco runing in Excle 2010 and Excel 2013. And to narrow donw the issue to which line we also can add the track code to the sub.

    Hope it is hlepful.

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Friday, September 4, 2015 5:27 AM

All replies

  • Hi JZEPEDA,

    To narrrow down this issue, I suggest that you insert the code to track the time cost to find which line of code caused this issue.

    In addition, can you reproduce this issue on a clean machine which installed Excel 2013? If not, I suggest that you repair or update the Excel application to the latest version.

    If yes, would you mind sharing the code that cause this issue?

    For example, you can use code below to track the time costing for the code:

    a = Time
    
    'code here
    Debug.Print DateDiff("s", a, Time)
    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, September 3, 2015 5:32 AM
  • Hi,

    I'm going to copy and paste the code below: (again I don't know anything about VBA). What this particular script does is move all of the data from the RAW DATA sheet into the appropriate worksheet based on some logic (I'm still not sure what exactly, though I believe it is the two Planner column headers in A and F of the RAW DATA sheet (after I paste it in)).

    I should also note that I inserted a code from another post on this forum and it took 5 minutes from 4 hours. This is the first Sub/End Sub you will see.

    Thank you for your help :-).

    Julie

    Sub GenerateTimeSheet()
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect
    Application.ScreenUpdating = True
    End Sub
    
    Sub MoveLaunch()
    'Launches all the subroutines to move data to the appropriate subsheets
    
        MoveASO
        MoveMux
        MoveRF
        MoveBSO
        MoveBEM
        MoveSolar
        MoveBusMech
        MoveSubCon
        MoveRSO
        MoveBatt
        MoveSM
        MoveThermo
        ClearRawData
        
    End Sub
    
    Sub MoveASO()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
    
        Worksheets("ASO").Activate
        If Worksheets("ASO").FilterMode = True Then Worksheets("ASO").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("ASO  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="ANTE"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no ANTE records for ASO."
        Else
            MsgBox "There are " & mySubtotal & " ANTE records for ASO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("ASO").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
    
        
        End Sub
    
    Sub MoveMux()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("MUX").Activate
        If Worksheets("MUX").FilterMode = True Then Worksheets("MUX").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("MUX  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="MUXL"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no MUXL records for Mux."
        Else
            MsgBox "There are " & mySubtotal & " MUXL records for MUX."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("MUX").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
    
        
    End Sub
    
    Sub MoveRF()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("RF Active").Activate
        If Worksheets("RF Active").FilterMode = True Then Worksheets("RF Active").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("RF  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="COMM"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no COMM records for RF."
        Else
            MsgBox "There are " & mySubtotal & " COMM records for RF."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RF Active").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="LCMP"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no LCMP records for RF."
        Else
            MsgBox "There are " & mySubtotal & " LCMP records for RF."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RF Active").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SWCC"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SWCC records for RF."
        Else
            MsgBox "There are " & mySubtotal & " SWCC records for RF."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RF Active").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub MoveSubCon()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
    
        Worksheets("Subcontracts").Activate
        If Worksheets("Subcontracts").FilterMode = True Then Worksheets("Subcontracts").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("SubCon  Last row = " & Lrow & " Last column = " & Lcol)
    
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SUBC"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SUBC records for SubCon."
        Else
            MsgBox "There are " & mySubtotal & " SUBC records for SubCon."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Subcontracts").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub MoveBEM()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("BEM").Activate
        If Worksheets("BEM").FilterMode = True Then Worksheets("BEM").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("BEM  Last row = " & Lrow & " Last column = " & Lcol)
    
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM1"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If IsEmpty(Range("F6:F12").Value) Then
            MsgBox "There are no BEM1 records for BEM."
        Else
            MsgBox "There are " & mySubtotal & " BEM1 records for BEM."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BEM").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM2"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If IsEmpty(Range("F6:F12").Value) Then
            MsgBox "There are no BEM2 records for BEM."
        Else
            MsgBox "There are " & mySubtotal & " BEM2 records for BEM."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BEM").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM3"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If IsEmpty(Range("F6:F12").Value) Then
            MsgBox "There are no BEM3 records for BEM."
        Else
            MsgBox "There are " & mySubtotal & " BEM3 records for BEM."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BEM").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM4"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If IsEmpty(Range("F6:F12").Value) Then
            MsgBox "There are no BEM4 records for BEM."
        Else
            MsgBox "There are " & mySubtotal & " BEM4 records for BEM."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BEM").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM5"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If IsEmpty(Range("F6:F12").Value) Then
            MsgBox "There are no BEM5 records for BEM."
        Else
            MsgBox "There are " & mySubtotal & " BEM5 records for BEM."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BEM").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
    
    End Sub
    
    Sub MoveRSO()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("RSO").Activate
        If Worksheets("RSO").FilterMode = True Then Worksheets("RSO").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("RSO  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="MUXL"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no MUXL records for RSO."
        Else
            MsgBox "There are " & mySubtotal & " MUXL records for RSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RSO").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SWCC"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SWCC records for RSO."
        Else
            MsgBox "There are " & mySubtotal & " SWCC records for RSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="COMM"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no COMM records for RSO."
        Else
            MsgBox "There are " & mySubtotal & " COMM records for RSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
          
    
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="LCMP"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no LCMP records for RSO."
        Else
            MsgBox "There are " & mySubtotal & " LCMP records for RSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("RSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
    
        
    End Sub
    
    Sub MoveBSO()
    
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
                
        Worksheets("BSO").Select
        If Worksheets("BSO").FilterMode = True Then Worksheets("BSO").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("BSO  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM1"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BEM1 records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " BEM1 records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM2"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BEM2 records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " BEM2 records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM3"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BEM3 records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " BEM3 records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
    
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM4"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BEM4 records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " BEM4 records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BEM5"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BEM5 records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " BEM5 records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SENS"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SENS records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " SENS records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="MECH"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no MECH records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " MECH records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BATT"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BATT records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " BATT records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="PROP"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no PROP records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " PROP records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="CMIN"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no CMIN records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " CMIN records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="STRT"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no STRT records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " STRT records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="TOWR"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no TOWR records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " TOWR records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="PANL"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no PANL records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " PANL records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="HARN"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no HARN records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " HARN records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SOLR"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SOLR records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " SOLR records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="RMCH"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no RMCH records for BSO."
        Else
            MsgBox "There are " & mySubtotal & " RMCH records for BSO."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("BSO").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub MoveSM()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("Sens-Mech-Contrls").Activate
        If Worksheets("Sens-Mech-Contrls").FilterMode = True Then Worksheets("Sens-Mech-Contrls").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("SM  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SENS"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SENS records for SM."
        Else
            MsgBox "There are " & mySubtotal & " SENS records for SM."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Sens-Mech-Contrls").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="MECH"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no MECH records for SM."
        Else
            MsgBox "There are " & mySubtotal & " MECH records for SM."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Sens-Mech-Contrls").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
    
    End Sub
    
    Sub MoveBatt()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
    
        Worksheets("Battery").Activate
        If Worksheets("Battery").FilterMode = True Then Worksheets("Battery").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("Batt  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="BATT"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no BATT records for Batt."
        Else
            MsgBox "There are " & mySubtotal & " BATT records for Battery."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Battery").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub MoveThermo()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("Thermodynamics").Activate
        If Worksheets("Thermodynamics").FilterMode = True Then Worksheets("Thermodynamics").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("Thermo  Last row = " & Lrow & " Last column = " & Lcol)
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="CMIN"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no CMIN records for Thermo."
        Else
            MsgBox "There are " & mySubtotal & " CMIN records for Thermo."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Thermodynamics").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="PROP"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no PROP records for Thermo."
        Else
            MsgBox "There are " & mySubtotal & " PROP records for Thermo."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Thermodynamics").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub MoveBusMech()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("Bus Mech Activity").Activate
        If Worksheets("Bus Mech Activity").FilterMode = True Then Worksheets("Bus Mech Activity").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("BusMech  Last row = " & Lrow & " Last column = " & Lcol)
        
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="HARN"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no HARN records for BusMech."
        Else
            MsgBox "There are " & mySubtotal & " HARN records for BusMech."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Bus Mech Activity").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="TOWR"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no TOWR records for BusMech."
        Else
            MsgBox "There are " & mySubtotal & " TOWR records for BusMech."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Bus Mech Activity").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
    
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="PANL"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no PANL records for BusMech."
        Else
            MsgBox "There are " & mySubtotal & " PANL records for BusMech."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Bus Mech Activity").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="STRT"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no STRT records for BusMech."
        Else
            MsgBox "There are " & mySubtotal & " STRT records for BusMech."
            Range(Cells(6, 1), Range("A6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Bus Mech Activity").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub MoveSolar()
        On Error Resume Next
        Dim rng As Range
        Dim mySubtotal As Double
        Dim Lrow As Integer
        Dim Lcol As Integer
    
        Worksheets("Solar Array").Activate
        If Worksheets("Solar Array").FilterMode = True Then Worksheets("Solar Array").ShowAllData
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(3, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Clear
        'MsgBox ("Solar  Last row = " & Lrow & " Last column = " & Lcol)
        
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="RMCH"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no RMCH records for Solar."
        Else
            MsgBox "There are " & mySubtotal & " RMCH records for Solar."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Solar Array").Select
            Range("A3").Select
            ActiveSheet.Paste
        End If
        
        Sheets("RAW DATA").Select
        Selection.AutoFilter field:=6, Criteria1:="SOLR"
        Set rng = ActiveSheet.AutoFilter.Range
        mySubtotal = rng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If mySubtotal <= 0 Then
            MsgBox "There are no SOLR records for Solar."
        Else
            MsgBox "There are " & mySubtotal & " SOLR records for Solar."
            Range(Cells(6, 6), Range("F6").End(xlDown)).Select
            Selection.EntireRow.Copy
            Sheets("Solar Array").Select
            Range("F3").End(xlDown).Select
            Selection.Offset(1, -5).Select
            ActiveSheet.Paste
        End If
        
    End Sub
    
    Sub ClearRawData()
        On Error Resume Next
        Dim Lrow As Integer
        Dim Lcol As Integer
        
        Worksheets("RAW DATA").Activate
        If Worksheets("RAW DATA").FilterMode = True Then Worksheets("RAW DATA").ShowAllData
        'Range(Cells(6, 1), Range("A6").End(xlDown)).Select
        'Selection.EntireRow.Clear
        Lrow = ActiveSheet.UsedRange.Rows.Count
        Lcol = ActiveSheet.UsedRange.Columns.Count
        ActiveSheet.Range(Cells(6, 1), Cells(Lrow + 1, Lcol)).Select
        Selection.EntireRow.Delete
        
    End Sub


    Thursday, September 3, 2015 9:32 PM
  • Also, there are other macros which build histograms and what not, so this file is very large and takes time just to go from one sheet to the next, after the macro is run. Do let me know if you'd like me to paste the other scripts. :)

    Thursday, September 3, 2015 9:36 PM
  • Hi Julie,

    We can modify the code below to track the time costed by the specific sub:

    Sub MoveLaunch()
    'Launches all the subroutines to move data to the appropriate subsheets
    
        a = Time
        MoveASO
        
        'code here
        Debug.Print "Time costed for MoveAso sub: " & DateDiff("s", a, Time)
        a = Time
        MoveMux
        Debug.Print "Time costed for MoveMux sub: " & DateDiff("s", a, Time)
        
        MoveRF
        MoveBSO
        MoveBEM
        MoveSolar
        MoveBusMech
        MoveSubCon
        MoveRSO
        MoveBatt
        MoveSM
        MoveThermo
        ClearRawData
        
    End Sub

    Then you can compare the marco runing in Excle 2010 and Excel 2013. And to narrow donw the issue to which line we also can add the track code to the sub.

    Hope it is hlepful.

    Regards & Fei


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Friday, September 4, 2015 5:27 AM
  • JZEPEDA,

      Without knowing what your data looks like on the "Raw Data" sheet, we can only make some general statements.

    1. Place the following at the top of the Sub MoveLaunch -

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating=False

    2. Place the following at the bottom of Sub MoveLaunch

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating=True

    3. The copy and pasting takes a lot of resources. Take a look at the following page to see how to copy data from

    on sheet to another. Look for "Avoid the use of Copy and Paste whenever Possible:" on the webpage Speeding up VBA

    Let us know if this helps.

    Harry






    Friday, September 4, 2015 6:39 PM