Question

I have a document that I’m going to hand out to users with three non-contiguous groups of arbitrary numbers of rows (same number of columns across the board) depending on their individual needs.
My current macro is quite slow to run, so I was wondering if someone can suggest a better solution than what I have here, or at least point me in the direction of what built in functions may help what I’m doing.

In the script below, I have it set to act on the data in rows: 6, 8-19, 21-60, 63-81.

All this is meant to be doing is deleting the values in the first column of data (sFirstCol = “D”), and shifting values from all columns (E->AC) in the applicable rows one cell to the left, leaving the rightmost column values blank.

Sub RollOver1()
    Dim sFirstCol As String
    Dim sSecCol As String
    Dim sSLastCol As String
    Dim sLastCol As String
    Dim iFirstRow As Integer
    Dim iLastRow As Integer
    Dim excludeRows() As Variant

    sFirstCol = "D"
    sSecCol = "E"
    sSLastCol = "AB"
    sLastCol = "AC"
    iFirstRow = 6
    iLastRow = 81
    excludeRows = Array(7, 20, 61, 62)



    For i = iFirstRow To iLastRow
        Dim bExcludedRow As Boolean
        bExcludedRow = False
        For Each eR In excludeRows
            If eR = i Then
                bExcludedRow = True
            End If
        Next
        If bExcludedRow = False Then
            Range(sSecCol + LTrim(Str(i)) + ":" + sLastCol + LTrim(Str(i))).Select
            Selection.Copy
            Range(sFirstCol + LTrim(Str(i)) + ":" + sSLastCol + LTrim(Str(i))).Select
            ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, IconFileName:=False
            Range(sLastCol + LTrim(Str(i))).Select
            Selection.ClearContents
        End If
    Next

    Range(sFirstCol + LTrim(Str(iFirstRow + 1))).Select
    ActiveCell.FormulaR1C1 = "='Sheet1'!R[4]C[2]"
    Range(sLastCol + LTrim(Str(iFirstRow))).Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+7"

    Range("A1").Select

End Sub

Answer 1

Here are some pointers that will speed up your code:

Dim all you variables

Dim i As long
Dim eR As variant

At the start of your routine, set Calculation to Manual, turn off ScreenUpdating and Events.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Turn them on again at the end

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = true

Don’t Select ranges you want to process. Set a variable and act on that. Example:

Dim rng as Range
Set rng = Range(sSecCol + LTrim(Str(i)) + ":" + sLastCol + LTrim(Str(i)))
rng.Copy

Don’t act on you sheet one row at a time, act on a contiguous range. In this case this will involve some more complex calculations to work out the rows between excluded rows, but it will have a net benefit.

There are many ways to ‘move’ the data, some probably faster than Copy, Paste, Clear. But once you have applied the hints above you may find the routine runs fast enough. If not, post again.