1

This code takes raw data and drops it into a report template where it is transformed using if then statements and conditional formatting. Data is downloaded from an online source. The imported file is moved into the workbook. The user then runs this macro to merge the imported file into the report template.

Before adding the ActiveWorkbook.Save line, this code would only run about half the time. Now it runs consistently, but its slow and goes into Excel "Not Responding" for several seconds before completing. Can someone help me make this code more efficient?

Sub Refresh()
' Refresh Macro

' Checks the import data for accurate column headings, then refreshes the Standup Report with the new import data.  Keeps Board Status Entries

Dim ColumnOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer

Dim rTemplate As Worksheet, nImport As Worksheet
Set rTemplate = ThisWorkbook.Worksheets("Standup Report Template")

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual


On Error GoTo ErrHandler

'Move the "Standup Report Template" Worksheet to first position.
rTemplate.Move Before:=ActiveWorkbook.Sheets(1)

    'Order Columns correctly
    On Error Resume Next

    Set nImport = ThisWorkbook.Worksheets(2)

    nImport.Activate

    ColumnOrder = Array("Formatted ID", "Name", "Schedule State", "Blocked", "Plan Estimate", "At Risk", "Added")
    counter = 1

    For ndx = LBound(ColumnOrder) To UBound(ColumnOrder)
        Set Found = Rows("1:1").Find(ColumnOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
        counter = counter + 1

        End If
    Next ndx


    'Check to make sure all columns are present
    On Error GoTo ErrHandler

    If Range("A1").Value = "Formatted ID" And Range("b1").Value = "Name" And Range("c1").Value = "Schedule State" And Range("d1").Value = "Blocked" And Range("e1").Value = "Plan Estimate" And Range("f1").Value = "At Risk" And Range("g1").Value = "Added" Then


        'insert formula to retain the current board state into column H of the new import file.

        Application.Calculation = xlAutomatic

        Range("H2").Formula = "=IF(ISERROR(MATCH(A2,'Standup Report Template'!B:B,0)),""NEW"",IF(ISBLANK(INDEX('Standup Report Template'!$B$1:$L$200,MATCH(A2,'Standup Report Template'!B:B,0),11)),""-"",INDEX('Standup Report Template'!$B$1:$L$200,MATCH(A2,'Standup Report Template'!B:B,0),11)))"
        With Sheets(2)
            .Range("H2").AutoFill .Range("H2:H" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        End With

        Application.Calculation = xlManual

        'clear old data from report
        rTemplate.Activate
        Application.Goto Reference:="ClearEntries"
        Selection.ClearContents

        'Delete Header Row of New Import file
        nImport.Rows("1:1").Delete Shift:=xlUp

        'Assign (instead of copy paste) new import data to the report template
        rTemplate.Range("B4:H104").Value = nImport.Range("A1:G100").Value

        'Justify Text
        With Columns("B:B")
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
        End With

        With Columns("C:C")
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
        End With

        With Columns("D:H")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With

        With Range("B3:H3")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With

        'Copy Paste Revised Board State
        nImport.Activate
        ActiveSheet.UsedRange.Columns("H:H").Copy


        rTemplate.Activate
        Range("L4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

        'Delete import file
        nImport.Delete

        rTemplate.Activate
        Range("L4").Select
        ActiveWindow.Zoom = 80

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic


        MsgBox "New data has been imported. Please update the Board State as needed to finalize the report."



    Else:

        Rows("1:1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 7765734
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With

        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.Calculation = xlAutomatic


        MsgBox "The columns in your import table must be ordered as follows:" & vbCrLf & vbCrLf & "Formatted ID" & vbCrLf & "Name" & vbCrLf & "Schedule State" & vbCrLf & "Blocked" & vbCrLf & "Plan Estimate" & vbCrLf & "At Risk" & vbCrLf & "Added" & vbCrLf & vbCrLf & "Please make the appropriate changes to your import table and try again."




End If

Exit Sub

ErrHandler:

MsgBox "The Stand Up Report can't find your data.  Please move data into the workbook before trying again."




End Sub
td4
  • 11
  • 2

1 Answers1

0

Don't use select on a range, it's extremely costly, here is an example to avoid it:

    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With

Becomes:

    With Columns("B:B")
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With

Note remove the .Select and the Selection.

I would probably also turn off calculation at the start of the code and back on at the end.

If you decide to do that, then you will need to do a manual Calculate after entering a formula like here:

    Range("H2").Formula = "=IF(ISERROR(MATCH(A2,'Standup Report Template'!B:B,0)),""NEW"",IF(ISBLANK(INDEX('Standup Report Template'!$B$1:$L$200,MATCH(A2,'Standup Report Template'!B:B,0),11)),""-"",INDEX('Standup Report Template'!$B$1:$L$200,MATCH(A2,'Standup Report Template'!B:B,0),11)))"
    With Sheets(2)
        .Range("H2").AutoFill .Range("H2:H" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    Application.calculate
Dan Donoghue
  • 6,056
  • 2
  • 18
  • 36
  • Thanks for your help @DanDonoghue. Value your feedback on my update. Step through works fine, but run does not. Thanks. – td4 Mar 02 '20 at 21:51
  • Comment out this line `On Error GoTo ErrHandler` and run it then see where it crashes and we can work out why. – Dan Donoghue Mar 02 '20 at 21:53