vba excel compare columns in two different sheets then copy row from one to the other column at the duplicate row count

Question

Two columns, separate sheets, each have part number in them. Column1 is updated and Column2 is copied from Column1 before Column1 is updated to retain associated row values and information per part number. Now if Column1 is updated and the row counts between Column1 and Column2 don't match anymore, I cannot find anything on comparing columns with different row counts where duplicates occur. How can I compare the columns and if there is a duplicate, take the duplicate row from Column2 and copy it to Column1 where the duplicate occurred(same part number)? Like if before Column1 was updated there was a part number 2222 in cell A1, so that data would be copied over to Column2 to A1. After the update of Column1 the part number 2222 might be in A8 now. Now the row counts don't match between columns, so I cannot do row count, and I cannot just copy a range over from one sheet to the other. Any help would be much appreciated.

Sub DeleteRowsandCopyRowstoduplicate()

'Deletes rows where one cell does not meet criteria

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("machine schedule")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sync Data")
Dim criteria As String
Dim found As Range
Dim i As Long

Application.ScreenUpdating = False

For i = 60 To 3 Step -1
   criteria = ws2.Cells(i, 1).Value
   On Error Resume Next
   Set found = ws1.Range("A:A").Find(What:=criteria, LookAt:=xlWhole)
   On Error GoTo 0
If found Is Not Nothing Then
    ws2.Cells(i, 1).EntireRow.Copy Destination:= '**not sure what to put here because it's always changing

If found Is Nothing Then
     ws2.Cells(i, 1).EntireRow.ClearContents ' or .Delete
   End If

  Next i

Application.ScreenUpdating = True

End Sub

ron ron · Accepted Answer · 2014-01-15T15:57:04

Your new info changes my understanding of the problem, so I've modified the macro accordingly. I've tested this and it gives the same output as what you posted in your links. Hopefully it does what you want.

Sub DeleteRowsandCopyRowstoduplicate()

' Deletes rows where one cell does not meet criteria

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("machine schedule")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sync Data")
Dim criteria As String
Dim found As Range
Dim i As Long

    Application.ScreenUpdating = False

' Determine the number of row of updated data on ws 2
    ws2.Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    numb = Selection.Rows.Count

' Iterate through the data, when data from col A of ws2 is found to match data
' in col A of ws1, add data from all other columns to ws1
    For i = numb To 1 Step -1
        ws2.Select
        Cells(i, 1).Select
        ActiveCell.EntireRow.Copy
        criteria = ActiveCell

        my_marker = 1
        ws1.Select
        Range("A1").Select  ' or wherever it's appropriate to start
        Do Until IsEmpty(ActiveCell) = True
           If ActiveCell = criteria Then
                ActiveSheet.Paste
                my_marker = 2
                Exit Do
           Else
           End If
           ActiveCell.Offset(1, 0).Select
        Loop

        ws2.Select
        If my_marker = 1 Then
            ws2.Cells(i, 1).EntireRow.Delete
        Else
        End If
    Next i

' Remove any rows from ws1 that were not on ws2
    ws1.Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    numb2 = Selection.Rows.Count
    Range("B1").Select

    For i = 1 To numb2
        If IsEmpty(ActiveCell) = True Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Next
    Range("A1").Select

' sort ws2 by col A
    ws2.Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

vba excel compare columns in two different sheets then copy row from one to the other column at the duplicate row count

1 Answers