Compare column B - If exists then update date, else copy to end

**jimbob121** · 08-06-2011, 01:55 PM

Hi all

I am looking for some help with a macro. I am looking to use the value in column B on sheet 1 to check if they exist on sheet 2 column B. If they do exist then copy the data from sheet 1 to sheet 2 in order to update the data. If the data does not exist then copy the data to the end of the data on sheet 2. I am trying to consolidate some reports so need to copy the data as is. So on finding a match only copy the data on the row, in the example columns A to D, not the full row as this would upset the data that will be on my proper data.

Many thanks for any help in advance

Jim

**JBeaucaire** · 08-06-2011, 02:06 PM

This should do it:

Option Explicit

Sub UpdateSheet2()
Dim ws1 As Worksheet    'source data
Dim ws2 As Worksheet    'target
Dim vFIND As Range
Dim MyV As Range
Dim NR As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

NR = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1
On Error Resume Next

For Each MyV In ws1.Range("B2", ws1.Range("B" & ws1.Rows.Count).End(xlUp))
    Set vFIND = ws2.Range("B:B").Find(MyV, LookIn:=xlValues, LookAt:=xlWhole)
    If Not vFIND Is Nothing Then
        ws2.Rows(vFIND.Row).Value = ws1.Rows(MyV.Row).Value
        Set vFIND = Nothing
    Else
        ws2.Rows(NR).Value = ws1.Rows(MyV.Row).Value
        NR = NR + 1
    End If
Next MyV

End Sub

**tigeravatar** · 08-06-2011, 02:06 PM

Jim,

Something like this?

Sub tgr()
    
    Static ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
    Static ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
    Static ur As Range: Set ur = ws1.UsedRange
    Static rngB As Range: Set rngB = Intersect(ur.Offset(1).Resize(ur.Rows.Count - 1), ws1.[B:B])
    If rngB Is Nothing Then Exit Sub
    
    Dim BCell As Range, BFound As Range
    For Each BCell In rngB
        Set BFound = Nothing
        Set BFound = ws2.[B:B].Find(Trim(BCell.Value))
        If Not BFound Is Nothing Then
            ws2.Cells(BFound.Row, "A").Resize(1, 4).Value = ws1.Cells(BCell.Row, "A").Resize(1, 4).Value
        Else
            ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 4).Value = ws1.Cells(BCell.Row, "A").Resize(1, 4).Value
        End If
    Next BCell
    
End Sub

Hope that helps,
~tigeravatar