Copied rows automatically update each time another row is added. How to change this?

[ozc1han]

Hi all,

Is there any way to change this code so, each time I need to make a change to a row, when I double click column H (H4:H2000), it only updates the column I have double clicked.

For example, if I have input data for 30 rows in sheet 1 (checklist) and copied them all over to sheet 2 (inspection report) it works fine.
If however, I then need to update one of the rows, it currently re-copies all data for all 30 rows.

I want to know if there is a way I can copy each row from sheet 1 to sheet 2, and if I make a change to one row, I don't want that change to revert back to the data in sheet 1 once another row has been added from sheet 1.


I've included the code below:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("H4:H2000")) Is Nothing Then
    Application.EnableEvents = False
        
        If ActiveCell.Value = ChrW(&H2713) Then
            ActiveCell.clearcontents
            ActiveCell.EntireRow.Interior.Color = xlNone
        Else
            ActiveCell.Value = ChrW(&H2713)
            ActiveCell.EntireRow.Interior.ColorIndex = 2
        End If
        Application.ScreenUpdating = True
    
    Cancel = True
    
End If

Application.EnableEvents = True

    Copy_n_Paste

End Sub


Sub Copy_n_Paste()
On Error Resume Next

    Dim srchtrm As String
    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range
    Dim i As Integer
    Dim Today As Date
    
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Sheet11.Rows("16:2000").Delete
    
    Set shtSrc = Sheets("Checklist")    'source sheet
    Set shtDest = Sheets("Inspection Report")    'destination sheet
    destRow = 16 'start copying to this row
    
    
    'don't scan the entire column...
    Set rng = Application.Intersect(shtSrc.Range("H:H"), shtSrc.UsedRange)

    For Each c In rng.Cells
        If c.Value = ChrW(&H2713) Then
            
            c.EntireRow.Copy shtDest.Cells(destRow, 1)
          
            destRow = destRow + 1

        End If
    Next
    
    Sheet11.Columns("A:H").EntireColumn.AutoFit
            
            Worksheets("Inspection Report").Range("A:A").ColumnWidth = 3
            Worksheets("Inspection Report").Range("B:B").ColumnWidth = 38
            Worksheets("Inspection Report").Range("C:C").ColumnWidth = 1.5
            Worksheets("Inspection Report").Range("D:D").ColumnWidth = 38
            Worksheets("Inspection Report").Range("E:E").ColumnWidth = 40
            Worksheets("Inspection Report").Range("F:F").ColumnWidth = 5
            Worksheets("Inspection Report").Range("G:G").ColumnWidth = 10
            Worksheets("Inspection Report").Range("H:H").ColumnWidth = 4
            Sheet11.Rows("16:2000").Rows.AutoFit
            
        
        
    
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
        
    Application.CutCopyMode = False
    Sheets("Operations - Data").Range("A1").Select

End Sub

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Copied rows automatically update each time another row is added. How to change this?
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[ozc1han]

Post has been removed from the other site.