VB Code to compare a single number to a list of numbers and report the row.

[PhilUK]

Hi all,

I am trying to set up a macro to copy across data from one Workbook (WB1) to another (WB2) and have managed to get most of the code together. However there is one final addition I would like to make and I can't seem to find a way of doing it.

What I would like to do is:
1. Copy data from WB1 to WB2. The data has an associated unique number which is copied over as well. (i.e. 00001, 00002 etc). This finds the last empty row and copies the data there - COMPLETE

2. Compare the unique number in WB1 to the column of unique numbers in WB2, if the unique number is present, copy the data to the row where it appears (thus overwriting the previously copied data). If not, do the above process and copy to the next empty row.

EDIT: Here is the code as it stands

Sub DataToLogSheet()

Dim LastRow As Long

'Objects
'- 2 Workbooks, 1 to copy from, 1 to paste to
'- 2 Worksheets, 1 to copy from, 1 to paste to
'- 1 Range, to copy and paste
Dim wb1, wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim r As Range


'Current workbook and open a second workbook
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("Workbook2.xls")

'Sheet1 & Sheet1 in both workbooks
Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet1")


'Activate Sheet1 in 1st Workbook,
'Select the range B2:B9 and
'copy it.
ws1.Activate
Set r = ws1.Range("B2:B9")
r.Copy

'Activate Sheet1 in 2nd Workbook,
ws2.Activate


If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

End If

ws2.Cells(LastRow + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

'copies back unique number to WS1 to prevent it updating the number.
ws2.Cells(LastRow + 1, 1).Copy
ws1.Activate
ws1.Cells(2, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

ws2.Activate
ActiveWorkbook.Close True

ws1.Activate

'Release object variables
Set r = Nothing
Set ws2 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set wb1 = Nothing

End Sub

Hopefully this makes sense. It may simple but I can;t find an example of it elsewhere.

Thanks in advance for any help/pointers.

Cheers
Phil