Optimizing Macro

S

sax2play

Board Regular
Joined
Mar 13, 2021
Messages
63
Office Version
  1. 2016
Platform
  1. Windows
Good Morning!

I have created a macro to reformat a data dump; however I am not a programmer or software writer and thus it is awful, slow and inefficient. I am hoping someone can help to clean this up so that it does not take an hour to run o_O

VBA Code: 
Sub PRTS_Reformat_1a()
'
' PRTS_Reformat_1 Macro
' Hide columns
'

'
    Application.ScreenUpdating = False
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Sheets.Add(Before:=Sheets(1)).Name = "EaselBoard_1"
    Dim fd As Office.FileDialog
    Dim strFile As String
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx?", 1
        .Title = "Choose a PRTS Export File"
        .AllowMultiSelect = False
        .InitialFileName = "C:\Users\" & Environ("UserName") & "\Downloads"
        If .Show = True Then
            strFile = .SelectedItems(1)
        Workbooks.Open Filename:=strFile
        End If
    End With
    Dim wa As Workbook: Set wa = ActiveWorkbook
    Dim last_row, last_col As Long
    wa.Sheets("EaselBoard_1").Select
    last_row = Cells(Rows.Count, 1).End(xlUp).Row
    last_col = Cells(1, Columns.Count).End(xlToLeft).Column
    Range(Cells(1, 1), Cells(last_row, last_col)).Select
    Selection.Copy
    wb.Activate
    wb.Sheets("EaselBoard_1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    wa.Activate
    wa.Close
    wb.Activate
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").ColumnWidth = 51.11
    Columns("E:E").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("F:F").ColumnWidth = 17.33
    Columns("G:G").ColumnWidth = 21.33
    Columns("H:H").ColumnWidth = 6
    Columns("I:I").ColumnWidth = 16.22
    Columns("J:J").ColumnWidth = 8.33
    Columns("K:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").ColumnWidth = 7.44
    Columns("Q:T").Select
    Selection.EntireColumn.Hidden = True
    Columns("U:V").Select
    Selection.EntireColumn.Hidden = True
    Columns("W:W").Select
    Selection.EntireColumn.Hidden = True
    Columns("X:X").ColumnWidth = 11.78
    Columns("Y:Y").Select
    Selection.EntireColumn.Hidden = True
    Columns("Z:Z").ColumnWidth = 18.56
    Columns("AA:AB").Select
    Selection.EntireColumn.Hidden = True
    Columns("AC:AD").Select
    Selection.EntireColumn.Hidden = True
    Columns("AE:AE").Select
    Selection.EntireColumn.Hidden = True
    Columns("AF:AF").ColumnWidth = 10.78
    Columns("AG:AG").ColumnWidth = 10.78
    Columns("AH:AH").Select
    Selection.EntireColumn.Hidden = True
    Columns("AI:AI").ColumnWidth = 18.89
    Columns("AJ:AJ").ColumnWidth = 17.89
    Columns("AK:AK").ColumnWidth = 18.33
    Columns("AL:AL").ColumnWidth = 17.44
    Columns("AM:AM").ColumnWidth = 11.89
    Columns("AI:AM").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("AN2").Select
    Columns("AN:AN").ColumnWidth = 9.33
    Columns("AO:AO").Select
    Selection.EntireColumn.Hidden = True
    Columns("AQ:AR").Select
    Selection.EntireColumn.Hidden = True
    Columns("AT:AU").Select
    Selection.EntireColumn.Hidden = True
    Columns("AW:AX").Select
    Selection.EntireColumn.Hidden = True
    Columns("BE:BG").Select
    Selection.EntireColumn.Hidden = True
    Columns("BD:BD").Select
    Selection.EntireColumn.Hidden = True
    Columns("BH:BH").ColumnWidth = 27.33
    Columns("BI:BI").ColumnWidth = 44
    Columns("BH:BH").ColumnWidth = 32.78
    Columns("BH:BH").ColumnWidth = 38.22
    Columns("BH:BI").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "NEXT STEPS"
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "NEXT STEPS"
    Columns("BK:BL").Select
    Selection.EntireColumn.Hidden = True
    Columns("BM:BM").ColumnWidth = 7.11
    Columns("BN:BN").ColumnWidth = 13.67
    Columns("BN:BN").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("BO:BR").Select
    Selection.EntireColumn.Hidden = True
    Columns("BS:BT").Select
    Selection.EntireColumn.Hidden = True
    Columns("BU:BU").ColumnWidth = 5.89
    Columns("BV:BW").Select
    Selection.EntireColumn.Hidden = True
    Columns("BX:BY").Select
    Selection.EntireColumn.Hidden = True
    Columns("BZ:BZ").ColumnWidth = 8.78
    Columns("CA:CA").Select
    Selection.EntireColumn.Hidden = True
    Columns("CB:CB").ColumnWidth = 7.67
    Columns("CC:CC").ColumnWidth = 8.56
    Columns("CD:CD").ColumnWidth = 14.89
    Columns("CD:CD").ColumnWidth = 11.56
    Columns("CD:CD").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("CE:CE").Select
    Selection.EntireColumn.Hidden = True
    Columns("CF:CF").ColumnWidth = 49.33
    Columns("CF:CF").Select
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("CG:CG").ColumnWidth = 16.44
    Columns("CG:CG").Select
    Selection.NumberFormat = "m/d/yyyy"
    Columns("CH:CH").Select
    Selection.EntireColumn.Hidden = True
    Columns("CI:CI").ColumnWidth = 14
    Columns("CJ:CJ").Select
    Selection.EntireColumn.Hidden = True
    Columns("CK:CK").ColumnWidth = 14.44
    Columns("CL:CN").Select
    Selection.EntireColumn.Hidden = True
    Columns("CO:CP").Select
    Selection.EntireColumn.Hidden = True
    Application.ScreenUpdating = True
End Sub
Sub PRTS_Reformat_2a()
'
' PRTS_Reformat_2 Macro
' Move Columns
'

'
    Application.ScreenUpdating = False
    Columns("F:G").Select
    Selection.Cut
    Columns("A:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("AF:AF").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("BN:BN").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Columns("AQ:AQ").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("AT:AT").Select
    Selection.Cut
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Columns("AW:AW").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").ColumnWidth = 3.56
    Columns("F:F").ColumnWidth = 3.56
    Selection.ColumnWidth = 3.56
    Columns("O:O").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Columns("AC:AC").Select
    Selection.Cut
    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight
    Range("N4").Select
    Columns("M:M").ColumnWidth = 9.11
    Columns("AE:AE").Select
    Selection.Cut
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    Columns("AK:AK").Select
    Selection.Cut
    Columns("O:O").Select
    Selection.Insert Shift:=xlToRight
    Range("CI1").Select
    ActiveCell.FormulaR1C1 = "DTC/FAULT_NUMBER"
    Columns("CI:CI").Select
    Selection.Cut
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight
    Range("P4").Select
    Columns("P:P").ColumnWidth = 8.44
    Columns("P:P").ColumnWidth = 7.33
    Columns("O:O").ColumnWidth = 9.22
    Columns("AR:AR").Select
    Selection.Cut
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight
    Columns("AS:AS").Select
    Selection.Cut
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight
    Range("R4").Select
    Columns("R:R").ColumnWidth = 6.67
    Columns("S:S").ColumnWidth = 41
    Columns("BJ:BK").Select
    Selection.Cut
    Columns("T:U").Select
    Selection.Insert Shift:=xlToRight
    Range("U5").Select
    Columns("V:V").Select
    Selection.Cut
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 3.22
    Range("CC1").Select
    Range("BO1").Select
    Columns("BO:BO").Select
    Selection.Cut
    Columns("W:W").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 4.33
    Columns("CA:CA").Select
    Selection.Cut
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight
    Columns("CC:CC").Select
    Selection.Cut
    Columns("Y:Y").Select
    Selection.Insert Shift:=xlToRight
    Columns("CD:CD").Select
    Selection.Cut
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight
    Columns("CE:CE").Select
    Selection.Cut
    Columns("AA:AA").Select
    Selection.Insert Shift:=xlToRight
    Columns("CG:CG").Select
    Selection.Cut
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight
    Range("AB4").Select
    Columns("AB:AB").ColumnWidth = 38.11
    Columns("CA:CA").Select
    Selection.Cut
    Columns("W:W").Select
    Selection.Insert Shift:=xlToRight
    Range("X4").Select
    Columns("W:W").ColumnWidth = 4.33
    Columns("AJ:AJ").Select
    Selection.ColumnWidth = 4.89
    Columns("AJ:AJ").Select
    Selection.Cut
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight
    Columns("CH:CH").Select
    Selection.Cut
    Columns("AE:AE").Select
    Selection.Insert Shift:=xlToRight
    Columns("AF:AF").Select
    Selection.Cut
    Columns("BO:BO").Select
    Selection.Insert Shift:=xlToRight
    Columns("AS:AT").Select
    Selection.EntireColumn.Hidden = False
    Columns("CJ:CL").Select
    Selection.EntireColumn.Hidden = False
    Columns("AS:AS").ColumnWidth = 14#
    Columns("AT:AT").ColumnWidth = 25.22
    Columns("CJ:CL").ColumnWidth = 11.44
    Columns("BT:BT").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Range("BB4").Select
    Application.ScreenUpdating = True
End Sub
Sub PRTS_Reformat_3a()
'
' PRTS_Reformat_3 Macro
' Conditional and Hyperlinks
'

'
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Rows("1:1").RowHeight = 100.8
    Rows("1:1").Select
    Selection.AutoFilter
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Range("L2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]>0,HYPERLINK(""https://website?id=""&RC[-1],RC[-1]),"""")"
    Range("L2:L1048576").Select
    Selection.FillDown
    Columns("K:K").Select
    Selection.EntireColumn.Hidden = True
    Range("L2:L1048576").Select
    With Selection.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .Color = 16711680
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("F:F").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Y", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Columns("G:G").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Y", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -4521714
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Columns("H:H").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Y", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16754788
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10284031
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("H1").Select
    Selection.FormatConditions.Delete
    Columns("I:I").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Closed", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "NEXT STEPS"
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "ASCTD_ISSUE_NUMBER"
    Range("AA1").Select
    Application.CutCopyMode = False
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]>0,HYPERLINK(""https://website?id=""&RC[-1],RC[-1]),"""")"
    Range("AB2:AB1048576").Select
    Selection.FillDown
    Columns("AB:AB").ColumnWidth = 10
    Range("AB2:AB1048576").Select
    With Selection.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .Color = 16711680
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("AA:AA").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").WrapText = True
    Columns("A:D").WrapText = True
    Columns("Q:Q").WrapText = True
    Columns("AD:AD").WrapText = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
Sub PRTS_Reformat_4a()
'
' PRTS_Reformat_4 Macro
' Final Reformatting
'

'
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Range("AB2:AB1048576").Select
    With Selection.Font
        .Name = "Tahoma"
        .FontStyle = "Regular"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .Color = 16711680
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
    Rows(ActiveCell.Row & ":" & Rows.Count).Delete
    Rows(ActiveCell.Row & ":" & Rows.Count).Hidden = True
    Range("BP2").Select
    Cells.Replace What:= _
        "2-Customer dissatisfier(incl. potential/bud of problem) / Major build concern(Ergo, excess labor/cost)" _
        , Replacement:="2", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:= _
        xlReplaceFormula2
    Cells.Replace What:= _
        "3-Moderate build concern (Asm Productivity, etc.) with NO CUSTOMER IMPACT", _
        Replacement:="3", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:= _
        xlReplaceFormula2
    Cells.Replace What:= _
        "1-Potential Walk Home/No-build (Potential or Actual), Non Safety Compliance, Non Safety Regulatory" _
        , Replacement:="1", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:= _
        xlReplaceFormula2
    Cells.Replace What:= _
        "*S-Potential Safety, Safety Compliance and/or Safety Regulatory Criteria", _
        Replacement:="*S", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
        False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:= _
        xlReplaceFormula2
    Columns("BP:BP").ColumnWidth = 5.44
    Columns("BQ:BQ").ColumnWidth = 6.22
    Columns("CM:CM").ColumnWidth = 9.33
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
Sub PRTS_Reformat_5a()
'
' PRTS_Reformat_5 Macro
' Final Reformatting 2
'

'
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Columns("R:R").ColumnWidth = 11.44
    Columns("S:S").ColumnWidth = 7.67
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 45
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("A:A").ColumnWidth = 7.67
    Columns("B:B").ColumnWidth = 11.25
    Columns("C:C").ColumnWidth = 9
    Columns("D:D").ColumnWidth = 10.5
    Columns("I:I").ColumnWidth = 6
    Columns("P:P").ColumnWidth = 11.56
    Columns("R:R").ColumnWidth = 10
    Columns("S:T").ColumnWidth = 6
    Columns("U:W").ColumnWidth = 36.44
    Columns("X:X").ColumnWidth = 3.44
    Columns("Y:Y").ColumnWidth = 3.22
    Columns("Z:Z").ColumnWidth = 3.33
    Columns("AB:AB").ColumnWidth = 8.33
    Columns("AC:AC").ColumnWidth = 4.56
    Columns("AG:AG").ColumnWidth = 8.89
    Columns("BA:BD").ColumnWidth = 14.56
    Columns("BL:BO").ColumnWidth = 3.67
    Columns("BP:BP").ColumnWidth = 3.67
    Columns("X:X").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Y", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("W1").Select
    With Selection.Font
        .Name = "Tahoma"
        .Size = 12
        .Bold = True
        .Color = -16776961
        .TintAndShade = 0
    End With
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
Sub PRTS_Reformat_6a()
'
' PRTS_Reformat_6 Macro
' Date and Save
'

'
    Range("CV1").Value = Date
    Range("CV1").NumberFormat = "mm.dd.yyyy"
    Range("CW1") = Month(Date)
    Range("CX1") = Day(Date)
    Range("CY1") = Year(Date)
    Range("A2").Select
    Dim NameFile As String
        With Worksheets("EaselBoard_1")
        NameFile = "Easel Board " & .Range("CW1") & "_" & .Range("CX1") & "_" & .Range("CY1") & ".xlsm"
        End With
        NameFile = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Desktop\" & NameFile, FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm")
        If fileSaveName <> "False" Then
            ActiveWorkbook.SaveAs Filename:=NameFile, FileFormat:=52
        End If
End Sub

Thank you so much in advance for anyone who can help!!!!
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
I see that you probably got most of your code using the Macro Recorder. It is a great tool, but it is very literal, and records every cell selection.
Typically, it is not necessary to select a range to work on it. And each "select/selection" slows your code down.
Most of the time, you can combine rows of code where one lines ends in "Select" and the next starts with "Selection".

So, instances like this:
VBA Code: 
Columns("K:O").Select
Selection.EntireColumn.Hidden = True
can be simplified to this:
VBA Code: 
Columns("K:O").EntireColumn.Hidden = True

And situations like this:
VBA Code: 
Columns("BN:BN").Select
With Selection
can be simplified to this:
VBA Code: 
With Columns("BN:BN")

You have lots of places in your code where you can shorten the code and speed it up in this manner.

This is one of the most common things you can do to take code that was recorded and make it more efficient.
I see that you are already suppressing calculations and sheet updating while the macro runs, so that is good too.
 
Upvote 0
Great, thank you so much for the advice Joe4!! I will work on making those changes and see if it helps!
 
Upvote 0
So I removed all of the "select/selection" from the macro; however it did not speed it up much if at all. The code below is the part that takes the longest as it is moving and reformatting large amounts of data. Is there a way to make this more efficient??

VBA Code: 
Sub PRTS_Reformat_2aNEW()
'
' PRTS_Reformat_2 Macro
' Move Columns
'

'
    Application.ScreenUpdating = False
    Columns("F:G").Cut
    Columns("A:B").Insert Shift:=xlToRight
    Columns("AF:AF").Cut
    Columns("C:C").Insert Shift:=xlToRight
    Columns("BN:BN").Cut
    Columns("D:D").Insert Shift:=xlToRight
    Columns("AQ:AQ").Cut
    Columns("E:E").Insert Shift:=xlToRight
    Columns("AT:AT").Cut
    Columns("F:F").Insert Shift:=xlToRight
    Columns("AW:AW").Cut
    Columns("G:G").Insert Shift:=xlToRight
    Columns("E:G").ColumnWidth = 3.56
    Columns("O:O").Cut
    Columns("H:H").Insert Shift:=xlToRight
    Columns("AC:AC").Cut
    Columns("M:M").Insert Shift:=xlToRight
    Columns("M:M").ColumnWidth = 9.11
    Columns("AE:AE").Cut
    Columns("N:N").Insert Shift:=xlToRight
    Columns("AK:AK").Cut
    Columns("O:O").Insert Shift:=xlToRight
    Range("CI1").FormulaR1C1 = "DTC/FAULT_NUMBER"
    Columns("CI:CI").Cut
    Columns("P:P").Insert Shift:=xlToRight
    Columns("P:P").ColumnWidth = 7.33
    Columns("O:O").ColumnWidth = 9.22
    Columns("AR:AR").Cut
    Columns("Q:Q").Insert Shift:=xlToRight
    Columns("AS:AS").Cut
    Columns("R:R").Insert Shift:=xlToRight
    Columns("R:R").ColumnWidth = 6.67
    Columns("S:S").ColumnWidth = 41
    Columns("BJ:BK").Cut
    Columns("T:U").Insert Shift:=xlToRight
    Columns("V:V").Cut
    Columns("I:I").Insert Shift:=xlToRight
    Columns("I:I").ColumnWidth = 3.22
    Columns("BO:BO").Cut
    Columns("W:W").Insert Shift:=xlToRight
    Columns("W:W").ColumnWidth = 4.33
    Columns("CA:CA").Cut
    Columns("X:X").Insert Shift:=xlToRight
    Columns("CC:CC").Cut
    Columns("Y:Y").Insert Shift:=xlToRight
    Columns("CD:CD").Cut
    Columns("Z:Z").Insert Shift:=xlToRight
    Columns("CE:CE").Cut
    Columns("AA:AA").Insert Shift:=xlToRight
    Columns("CG:CG").Cut
    Columns("AB:AB").Insert Shift:=xlToRight
    Columns("AB:AB").ColumnWidth = 38.11
    Columns("CA:CA").Cut
    Columns("W:W").Insert Shift:=xlToRight
    Columns("W:W").ColumnWidth = 4.33
    Columns("AJ:AJ").ColumnWidth = 4.89
    Columns("AJ:AJ").Cut
    Columns("X:X").Insert Shift:=xlToRight
    Columns("CH:CH").Cut
    Columns("AE:AE").Insert Shift:=xlToRight
    Columns("AF:AF").Cut
    Columns("BO:BO").Insert Shift:=xlToRight
    Columns("AS:AT").EntireColumn.Hidden = False
    Columns("CJ:CL").EntireColumn.Hidden = False
    Columns("AS:AS").ColumnWidth = 14#
    Columns("AT:AT").ColumnWidth = 25.22
    Columns("CJ:CL").ColumnWidth = 11.44
    Columns("BT:BT").Cut
    Columns("D:D").Insert Shift:=xlToRight
    Application.ScreenUpdating = True
End Sub

Thanks in advance for any help!!
 
Upvote 0
I don't know if you have any calculations based on these ranges, or any event procedure VBA code that might be being called. If so, you will want to add these to your Screen Updating code at the beginning of the code:
VBA Code: 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
and then turn them all back on at the end of the code like this:
VBA Code: 
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

If that does not make any difference, then I suspect the issue is the sheer volume of your computer.
The only way I can think of to make that faster is to run it on a faster computer!
 
Upvote 0
LOL! I do not have any calculations or procedures at that point in the macro - it is just reformatting. I suspect, like you indicated, that it is due to volume of data (over 20,000 rows and growing). I added those anyways to see if it helps any - I already have a powerful computer running the macro. Guess it may be time to utilize one of our super computers :ROFLMAO:

Thanks!!
 
Upvote 0
sax2play said:
I already have a powerful computer running the macro. Guess it may be time to utilize one of our super computers
Click to expand...
I don't know what you situation is, but I know for me, I am working at home through VPN, and VPN really throttles things down, so it is much more efficient for me to run big things directly from the servers instead of from my computer I am using at home.
 
Upvote 0
Just to update:

I was able to get the macro from almost 60 minutes to down under 3 minutes by setting the values of one sheet equal to the values in another sheet in the correct order instead of copying and pasting the data, then reformatting (cut column, insert column, etc). Made several other changes as well to help it run more smoothly, but this was the main part:

VBA Code: 
Sub PRTS_Reformat_5_31_2021()
'
'
    Dim StartTime As Double
    Dim MinutesElapsed As String

    StartTime = Timer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Dim WB As Workbook: Set WB = ActiveWorkbook
    Sheets.Add(Before:=Sheets(1)).Name = "EaselBoard_1"
    Dim fd As Office.FileDialog
    Dim strFile As String
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx?", 1
        .Title = "Choose a PRTS Export File"
        .AllowMultiSelect = False
        .InitialFileName = "C:\Users\" & Environ("UserName") & "\Downloads"
        If .Show = True Then
            strFile = .SelectedItems(1)
        Workbooks.Open Filename:=strFile
        End If
    End With
    Dim wa As Workbook: Set wa = ActiveWorkbook
    Dim last_row, last_col As Long
    wa.Sheets("EaselBoard_1").Select
    last_row = Cells(Rows.Count, 1).End(xlUp).Row
    last_col = Cells(1, Columns.Count).End(xlToLeft).Column
    WB.Sheets("EaselBoard_1").Range("A1:A" & last_row).Value = wa.Sheets("EaselBoard_1").Range("F1:F" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("B1:B" & last_row).Value = wa.Sheets("EaselBoard_1").Range("G1:G" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("C1:C" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AF1:AF" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("D1:D" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BJ1:BJ" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("E1:E" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BN1:BN" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("F1:F" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AP1:AP" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("G1:G" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AS1:AS" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("H1:H" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AV1:AV" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("I1:I" & last_row).Value = wa.Sheets("EaselBoard_1").Range("J1:J" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("J1:J" & last_row).Value = wa.Sheets("EaselBoard_1").Range("H1:H" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("K1:N" & last_row).Value = wa.Sheets("EaselBoard_1").Range("A1:D" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("O1:O" & last_row).Value = wa.Sheets("EaselBoard_1").Range("X1:X" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("P1:P" & last_row).Value = wa.Sheets("EaselBoard_1").Range("Z1:Z" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("Q1:Q" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AG1:AG" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("R1:R" & last_row).Value = wa.Sheets("EaselBoard_1").Range("CI1:CI" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("S1:T" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AM1:AN" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("U1:U" & last_row).Value = wa.Sheets("EaselBoard_1").Range("E1:E" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("V1:W" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BH1:BI" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("X1:X" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BU1:BU" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("Y1:Y" & last_row).Value = wa.Sheets("EaselBoard_1").Range("P1:P" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("Z1:Z" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BM1:BM" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AA1:AA" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BZ1:BZ" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AB1:AB" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BZ1:BZ" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AC1:AE" & last_row).Value = wa.Sheets("EaselBoard_1").Range("CB1:CD" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AF1:AH" & last_row).Value = wa.Sheets("EaselBoard_1").Range("CF1:CH" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AI1:AM" & last_row).Value = wa.Sheets("EaselBoard_1").Range("K1:O" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AN1:AT" & last_row).Value = wa.Sheets("EaselBoard_1").Range("Q1:W" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AU1:AU" & last_row).Value = wa.Sheets("EaselBoard_1").Range("Y1:Y" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("AV1:AZ" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AA1:AE" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BA1:BE" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AH1:AL" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BF1:BF" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AO1:AO" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BG1:BH" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AQ1:AR" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BI1:BJ" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AT1:AU" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BK1:BP" & last_row).Value = wa.Sheets("EaselBoard_1").Range("AW1:BB" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BQ1:BQ" & last_row).Value = wa.Sheets("EaselBoard_1").Range("I1:I" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BR1:BV" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BC1:BG" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BW1:BX" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BK1:BL" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("BY1:CD" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BO1:BT" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("CE1:CH" & last_row).Value = wa.Sheets("EaselBoard_1").Range("BV1:BY" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("CI1:CI" & last_row).Value = wa.Sheets("EaselBoard_1").Range("CA1:CA" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("CJ1:CJ" & last_row).Value = wa.Sheets("EaselBoard_1").Range("CE1:CE" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("CK1:CQ" & last_row).Value = wa.Sheets("EaselBoard_1").Range("CJ1:CP" & last_row).Value
    WB.Sheets("EaselBoard_1").Range("L1:L" & last_row).Value = WB.Sheets("EaselBoard_1").Range("K1:K" & last_row).Value
    wa.Worksheets("EaselBoard_1").Range("A1").Copy _
    WB.Worksheets("EaselBoard_1").Range("A1")
    Application.CutCopyMode = False
    WB.Sheets("EaselBoard_1").Activate
    Range("A1").Select
    Selection.Copy
    Rows("1:1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    wa.Activate
    wa.Close
    WB.Activate

Thanks for the help!
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
200
Coco1
C
Z
  • Solved
VBA Code to Hide columns in Specific Intervals
2
Replies
11
Views
375
jolivanes
jolivanes
D
  • Solved
Run-time error 9, Subscript out of range - Copying sheet from closed workbook to active workbook as new sheet
Replies
9
Views
291
dvward
D
S
  • Question
vba logic to open up several files within a folder and perform 2-3 steps
Replies
1
Views
103
ranman256
ranman256
P
  • Question
Help with Vba Code
Replies
3
Views
150
Coyotex3
C

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

Share this page

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