VBA Copy/Paste skipping every 5th row

Viewed 126

I am attempting to edit my code because although it functions as needed, I know it is not efficient. I am copying 5 merged cells at a time and pasting copied data in the column to the left before clearing the copied range.

Every 6th cell is skipped because it does not apply to what needs to be moved. A snippet is below, I know there is a much more efficient way to do what I am doing here, but I am brand new and have basically no experience in declaring variables or utilizing loops, functions, etc.

Thanks in advance!

Option Explicit

Sub ShiftWeeks()

    Dim answer As VbMsgBoxResult
    
    answer = MsgBox("Are you sure you want to copy/paste this weeks data?", vbYesNo, "Press Button for Macro")
        
    If answer = vbYes Then
        
        Range("c3:c8").Copy
        Range("b3:b8").PasteSpecial xlPasteValues
        Range("c3:c8").ClearContents
    
        Range("c10:c15").Copy
        Range("b10:b15").PasteSpecial xlPasteValues
        Range("c10:c15").ClearContents
    
        Range("c17:c22").Copy
        Range("b17:b22").PasteSpecial xlPasteValues
        Range("c17:c22").ClearContents
    
        Range("c24:c29").Copy
        Range("b24:b29").PasteSpecial xlPasteValues
        Range("c24:c29").ClearContents

    End If
    
End Sub

I've copied the same 3 code blocks quite a few times and have just changed the range. The button I made works, but I know the code is junk and it's not that difficult, but I don't know how to clean it up.

3 Answers

Not to nit-pick but it looks like you're actually copying 6 rows at a time, not 5 (e.g. C3:C8 is six rows). Following the same pattern you have above, you could use a For x = y to z step a -style loop, like below. If the last row will always be the same, you could define it with a lastRow = y statement, otherwise you can determine it dynamically with something like lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row.

For x = 3 To lastRow Step 7
    
    ws.Range(ws.Cells(x, 3), ws.Cells(x + 5, 3)).Copy
    ws.Range(ws.Cells(x, 2), ws.Cells(x + 5, 2)).PasteSpecial xlPasteValues
    ws.Range(ws.Cells(x, 3), ws.Cells(x + 5, 3)).ClearContents
    
Next x

Looping

If you need to add a dozen more ranges, having to repeat lines of code per range is tedious and will quickly become unmanageable. To avoid this issue, you can change the code into a loop.

There are two ways to create the loop.

By blocks:

Sub Example()
    For r = 3 To 24 Step 7
        With Cells(r, 3).Resize(6)
            .Offset(0, -1).Value = .Value
            .ClearContents
        End With
    Next
End Sub

And by cells:

Sub Example()
    Dim Cell As Range
    For Each Cell In Range("c3:c8,c10:c15,c17:c22,c24:c29")
        With Cell
            .Offset(0, -1).Value = .Value
            .ClearContents
        End With
    Next
End Sub

In the Block loop, we define the starting locations (r=3 and Cells ColumnIndex:=3) and then the block size (Step 7 and Resize(6)). In the Cells loop we simply define the range we want to operate within and execute the desired actions on every cell within that range.

In both methods, adding new locations to the macro would be as simple as changing the For loop statement line. Either by increasing the ending number from 24 or by adding more addresses to the Range.

Clipboard Copying

The clipboard is not a native feature of Excel and is actually a part of Windows. This means that when you use .Copy and .PasteSpecial in seperate lines, Excel has to communicate with windows and share the data. This is significantly slower than having the data stay within Excel. This issue is avoided by doing Range2.Value = Range1.Value and directly assigning the data without using the clipboard. You can also do Range1.Copy Destination:=Range2 but this will copy over the formatting as well as the values.

Additional Improvements

If you test out the cells loop, you'll notice that the application stutters and can be quite slow. To avoid this, you'll want to temporarily disable automatic actions by the application so that it doesn't pause during each loop. The application wants to re-calculate the sheet after every change and refresh the screen to display new values. Both of these are the cause of the stuttering and disabling them during the macro will speed things up significantly.

Sub Example()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    ''''''''''''''''
    'Code goes here'
    ''''''''''''''''
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Copy Merged Ranges

Option Explicit

Sub ShiftWeeks()

    Const wsName As String = "Sheet1"
    Const fRow As Long = 3
    Const sCol As String = "C"
    Const cOffset As Long = -1
    Const rOffset As Long = 7 ' needed only for the second solution
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)

    Dim answer As VbMsgBoxResult
    
    answer = MsgBox("Are you sure you want to copy/paste this weeks data?", vbYesNo, "Press Button for Macro")
        
    If answer = vbYes Then
        
        Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
        If lRow < fRow Then Exit Sub ' no data
        
        ' 1.) If the rows between the merged ranges are empty...
        Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(lRow - fRow + 1)
        srg.Offset(, cOffset).Value = srg.Value
        srg.Value = Empty
        
        ' 2.) ... otherwise:
        
'        Dim sCell As Range
'        Dim r As Long
'
'        For r = fRow To lRow Step rOffset
'            Set sCell = ws.Cells(r, sCol)
'            sCell.Offset(, cOffset).Value = sCell.Value
'            sCell.Value = Empty
'            'sCell.MergeArea.ClearContents
'        Next r

    End If
    
End Sub
Related