I am stuck writing this Excel macro and could kindly use some help. I am trying to create a dynamic macro that will compare two tables in two different sheets and will update information for a row if different or copy a new row to the new table if not there. Both tables contain the same columns of info and have a unique product code per data row. Once a button is pressed, if the product code for the row in table1 is not found on the new table then that row will copy. If the product code is found in the new table but other information in columns is different, than that other information will be updated on the new table. If the product code is found and the other information is the same then that row will not be copied. I need this for as many lines as possible in table1.

NOTE: I thought VLOOKUP may be the route to successfully code this macro...BELOW is my attempt so far to get this to work.

Sub Copy_Attempt()

Application.ScreenUpdating = False

Dim s1 As Worksheet, s2 As Worksheet

Set s1 = Sheets("Raw Data")
Set s2 = Sheets("BAS Linkage Master")

Dim i As Integer
Dim j As Integer


Dim Proj_ID As String
Dim Lookup_Range As Range
Dim Linkage_Lookup_Range As Range
Dim Raw_Percent_Complete As String
Dim Linkage_Percent_Complete As String

Set Lookup_Range = s1.Range("A1:O1000")

Set Linkage_Lookup_Range = s2.Range("A6:N1000")

For i = 2 To 1000

        Proj_ID = s1.Range("F" & i).Value

        Raw_Percent_Complete = Application.WorksheetFunction.VLookup(Proj_ID, Lookup_Range, 10, False)

Next

For j = 7 To 1000

        Linkage_Percent_Complete = s2.Range("I" & j).Value

Next

If Raw_Percent_Complete = Linkage_Percent_Complete Then

            ' DO NOT COPY THAT ROW OVER

Else



    Percent_Complete = Range("I" & j).Value

            'UPDATE PERCENT COMPLETE FOR THAT SPECIFIC PRODUCT CODE


End If

Sheets("Raw Data").Activate

Columns("H").EntireColumn.Delete

Range("A2:P1000").Select
Selection.Copy

Sheets("BAS Linkage Master").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select

Selection.PasteSpecial

      '  Sheets("Welcome").Activate

     '   Range("A11:O11").ClearContents

Sheets("Raw Data").Activate

Range("A2:N10000").ClearContents

Application.CutCopyMode = False
Application.ScreenUpdating = True

Sheets("BAS Linkage Master").Activate

End Sub
1

There are 1 best solutions below

1
On

This is a nice little script that looks for differences and highlights the differences.

Public Sub CompareSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell As Range, rng As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws1.Range("A1:B20")
For Each cell In rng
    Celladdress = cell.Address
    If cell <> ws2.Range(Celladdress) Then
        cell.Interior.Color = vbYellow
        ws2.Range(Celladdress).Interior.Color = vbYellow
    End If
Next cell

End Sub

You can use the same concept to copy the values from one table to another.

Public Sub CompareSheets()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim cell As Range, rng As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws1.Range("A1:B20")
For Each cell In rng
    Celladdress = cell.Address
    If cell <> ws2.Range(Celladdress) Then
        ws2.Range(Celladdress).Value = ws1.Range(Celladdress).Value
    End If
Next cell

End Sub