0
\$\begingroup\$

Firstly, this code works, but it is long and needlessly inefficient. I want to clean up the code.

I am working on a spreadsheet (this code is part of) that I import two other weekly updated spreadsheets into. After doing so, the two new sheets have to be formatted via TextToColumns and sorting (for an array I use). Additionally, after all the formatting, I have to update the pivots because the last code copies lines and places them at certain points and some of the data comes from the pivots. Basically, each week another row of data is added at the bottom of a column relating to each employee that then automatically updates a corresponding chart.

Sub WeeklyUpdate()
'
' WeeklyRoutine Macro
'
Dim x As Long, y As Long
Dim lLastRow As Long

    Sheets("PR Raw Data").Select
    Columns("EN:EN").Select
    Selection.TextToColumns Destination:=Range( _
        "BurnData[[#Headers],[est_po_place]]"), DataType:=xlDelimited, TextQualifier _
        :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
        False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 3) _
        , TrailingMinusNumbers:=True
    Range("EN2").Select
    ActiveWorkbook.Worksheets("PR Raw Data").ListObjects("BurnData").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("PR Raw Data").ListObjects("BurnData").Sort. _
        SortFields.Add Key:=Range("EN2"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("PR Raw Data").ListObjects("BurnData").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets("Current Week - SMPP Data").Select
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("SMPPTrend[[#Headers],[PR]]"), _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
        :=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
        Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Columns("I:I").Select
    Selection.TextToColumns Destination:=Range("SMPPTrend[[#Headers],[PR Age]]") _
        , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range( _
        "SMPPTrend[[#Headers],[Est PO Place Dt]]"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
    Selection.NumberFormat = "m/d/yyyy"
    Range("H2").Select
    ActiveWorkbook.Worksheets("Current Week - SMPP Data").ListObjects("SMPPTrend"). _
        Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Current Week - SMPP Data").ListObjects("SMPPTrend"). _
        Sort.SortFields.Add Key:=Range("H2"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Current Week - SMPP Data").ListObjects( _
        "SMPPTrend").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveWorkbook.RefreshAll

      With ThisWorkbook.Worksheets("Buyer Trend Metrics")

        y = 10
        For x = 61 To 70

            'This will set the last row on each set of data.
            lLastRow = .Cells(.Rows.Count, y).End(xlUp).Row + 1

            .Cells(lLastRow, y) = Date

            .Range(.Cells(lLastRow, y + 1), .Cells(lLastRow, y + 7)) = _
                .Range(.Cells(x, 2), .Cells(x, 8)).Value

            '-OR-
            '.Range(.Cells(x, 2), .Cells(x, 8)).Copy
            '.Cells(lLastRow, y + 1).PasteSpecial Paste:=xlPasteValues

            y = y + 9
        Next x
    End With

End Sub
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.