Compare data in 2 worksheets and update sheet 1

[eyeguy]

Hello all,

I have a workbook where I keep a current status on all of the files I work and an updated inventory of files assigned to me sent out daily. I am looking to be able to copy the data from the daily inventory to a second sheet in my status workbook, match the file numbers from column A of sheet 1 to the file numbers in column A of sheet 2, and both delete the rows of file numbers which are present in sheet 1, but not sheet 2 and insert rows for file numbers which are in sheet 2, but not sheet 1. This, in order to retain all duplicate values (i.e. files still active), delete all values not in the current inventory (i.e. closed files), and add all new values (i.e. new files not yet in status tracking spreadsheet) Furthermore, in the rows which are inserted into sheet 1, I need to copy the data from columns A,B,C & D of sheet 2 into columns A,B,D & I of sheet 1.

Right now this is taking me a solid 30-45 minutes to complete for approximately 200+ files in daily inventory and I'd really like to simplify the operation if possible.

Thank you very much for your help.

[eyeguy]

Any ideas?

[eyeguy]

Bump......

[JOHN H. DAVIS]

Maybe:

Sub eyeguy()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lr As Long
Dim lr2 As Long
Dim rcell As Range

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

lr = Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

Columns("B:B").Insert xlToRight

With Range("B2:B" & lr)

    .Formula = "=VLOOKUP(A2,Sheet2!$A$2:$A$8,1,FALSE)"
    .Value = .Value
    
End With

For Each rcell In Range("B2:B" & lr)

    If rcell.Text = "#N/A" Then rcell.EntireRow.Delete xlUp
    
Next rcell

Columns("B:B").Delete xlToLeft

ws2.Activate

lr2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

Columns("B:B").Insert xlToRight

With Range("B2:B" & lr2)

    .Formula = "=VLOOKUP(A2,Sheet1!$A$2:$A$8,1,FALSE)"
    .Value = .Value
    
End With

For Each rcell In Range("B2:B" & lr2)

    If rcell.Text = "#N/A" Then
    
    rcell.Offset(, -1).Copy ws1.Range("A" & Rows.Count).End(3)(2)
    rcell.Offset(, 1).Copy ws1.Range("B" & Rows.Count).End(3)(2)
    rcell.Offset(, 2).Copy ws1.Range("D" & Rows.Count).End(3)(2)
    rcell.Offset(, 3).Copy ws1.Range("I" & Rows.Count).End(3)(2)
    
    End If
    
Next rcell

Columns("B:B").Delete xlToLeft


End Sub