Duplicate Copy/Paste in VBA issue

GimpyHand

New Member
Joined
Jul 12, 2023
Messages
4
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Hey, I have some basic VBA code that copies a range (B:Z) from one sheet to another on worksheet_change. This works well and copies the values to the correct location (next empty row), but it also copies the same data to row 999+. Sometimes it;s 999, sometimes it's 1000, sometimes it's 1001.

There is nothing in the code that specifies this range or to copy the values to 2 locations.

I have attached the code for both sheets (Source and Destination) in case the worksheet_change code on the destination sheet is causing the issue. I have spent all morning trying to figure this out.

Thanks in advance for any help.

Source Sheet VBA
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo errhandler
    
    'Exit sub if the selection is out of bounds
    If Target.Column <> 27 Or Target.Row < 5 Or Target.Value <> "Yes" Then
        Exit Sub
    End If
    
    'Copy completed entries to Completed worksheet
    'Declare variables
    Dim datarow As Long
    Dim currentRow As Long
    Dim liveRow As Long
    Dim lastRow As Long
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim liveSheet As Worksheet
    
    'Set worksheet targets
    Set sourceSheet = ThisWorkbook.Worksheets("CI Master")
    Set destinationSheet = ThisWorkbook.Worksheets("Master")
    Set liveSheet = ThisWorkbook.Worksheets("Live Tracker")
    
    datarow = Target.Offset(0, 2).Value 'Grabbing the row the data is on by offsetting 2 columns to the right
    currentRow = Target.Offset(0, 3).Value 'Grab current row by offsetting 3 columns to the right
    
    'Copy values from source sheet to live sheet when toggling live to yes
    copyBZData = sourceSheet.Range("B" & currentRow & ":Z" & currentRow).Value
    lastRow = liveSheet.Cells(liveSheet.Rows.Count, "B").End(xlUp).Row 'Find the last row on Live Tracker sheet
    liveSheet.Range("B" & lastRow).Resize(, 25).Value = copyBZData 'Paste columns B to Z to liveSheet
    
    Set copyBZData = Nothing
       
    copyWZData = sourceSheet.Range("W" & currentRow & ":Z" & currentRow).Value
    destinationSheet.Range("W" & datarow & ":Z" & datarow).Value = copyWZData
    
    Set copyWZData = Nothing
    
    'Delete W:Z and shift contents up
    sourceSheet.Range("W" & currentRow & ":Z" & currentRow).Delete Shift:=xlShiftUp
    destinationSheet.Range("AA" & datarow).Value = "Yes" ' Set Live value to Yes on Master Sheet
    
    Target.Value = "" 'Set the selection to blank
        
errhandler:
    Exit Sub
End Sub

Destination Sheet VBA
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xCellColumn As Integer
    Dim xTimeColumn As Integer
    Dim xRow As Long
    Dim xCol As Long
    Dim xDPRg As Range
    Dim xRg As Range
    Dim datarow As Long
    Dim currentRow As Long
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet

    ' Set column and row targets
    xCellColumn = 28
    xTimeColumn = 29
    xRow = Target.Row
    xCol = Target.Column

    ' Paste Date/Time if Column X is not blank
    If Target.Text = "Yes" Then
        If xCol = xCellColumn Then
            Cells(xRow, xTimeColumn) = Now()
        Else
            On Error Resume Next
            Set xDPRg = Target.Dependents
            For Each xRg In xDPRg
                If xRg.Column = xCellColumn Then
                    Cells(xRg.Row, xTimeColumn) = Now()
                End If
            Next
        End If
    End If

    On Error GoTo errhandler

    ' Exit Sub if the selection is out of bounds
    If Target.Column() <> xCellColumn Or Target.Row() < 5 Or Target.Value() <> "Yes" Then
        Exit Sub
    End If

    ' Set worksheet targets
    Set sourceSheet = ThisWorkbook.Worksheets("Live Tracker")
    Set destinationSheet = ThisWorkbook.Worksheets("Master")

    datarow = Target.Offset(0, 3).Value ' Grabbing the row the data is on by offsetting one column to the left
    currentRow = Target.Offset(0, 2).Value ' Grab the row for the current sheet

    ' Copy values from source sheet to destination before toggling completed to yes
    With sourceSheet
        destinationSheet.Range("W" & datarow & ":Z" & datarow).Value = .Range("W" & currentRow & ":Z" & currentRow).Value
        destinationSheet.Range("AC" & datarow).Value = .Range("AC" & currentRow).Value
    End With

    destinationSheet.Range("AA" & datarow).Value = "No" ' Set the live value to No
    destinationSheet.Range("AB" & datarow).Value = "Yes" ' Set the completed value to Yes

    ' Clear the contents of the source range
    sourceSheet.Range("B" & currentRow & ":AC" & currentRow).Delete Shift:=xlShiftUp

    Target.Value = "" ' Reset the selection to blank

    ' Clean up
    Application.CutCopyMode = False

    Exit Sub

errhandler:
    Exit Sub

End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Does your Destination sheet have any even procedure VBA code in it as well?

Have you tried placing a breakpoint at the top of this code, and trigger an example to run, then go through the code one line at a time using the F8 and watch what happens on your sheet?
That is often a great way to see what exactly is happening, and when and where.
 
Upvote 0
Does your Destination sheet have any even procedure VBA code in it as well?

Have you tried placing a breakpoint at the top of this code, and trigger an example to run, then go through the code one line at a time using the F8 and watch what happens on your sheet?
That is often a great way to see what exactly is happening, and when and where.

I just did that and for some reason it's running through the 2 pages code 2-3x and a third page as well. Some weird looping going on, so I think I might need to start from scratch and rethink how I'm going to complete this task.
 
Upvote 0
Note that one must be careful when using the Worksheet_Change event procedure.
This is because this code is automatically triggered when a change is manually made to the sheet. However, if your code itself is making changes to the cells in the sheet itself, it could be calling the code to fire again! If you are not careful, you can get caught in a loop, maybe even an inifinite loop (depending on what the code does).

To avoid this, people often temporarily disable events from firing while the code is updating cells, so the code doesn't end up calling itself.
You would do this by adding this line of code before the code makes any updates to the sheet:
VBA Code:
Application.EnableEvents = False

Then, after all the lines of code making changes, you want to add a line of code turning events back on, so your automated code will fire again with the next manual change, i.e.
VBA Code:
Application.EnableEvents = True
 
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,959
Members
449,096
Latest member
Anshu121

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