Question

I have 2 sheets named orange book data alerts and total orange book data alerts , both sheets have data from A to M, unique value is in Column A in both the sheets. here I compare orange book data alerts with total orange book data alerts. When there is a match, compare its row cell values for each and every column and if there is difference the code should be written as Update in sheet orange book data alerts column N and if the unique value is not available it should write New addition in column N.. Below is code which i tried. it is working for if there is any update in data for one column, i need help so that i can compare all the columns and write as new addition if unique value is not present.

Sub compare10() 
Dim w1 As Worksheet, w2 As Worksheet 
Dim c As Range, a As Range 


Set w1 = Sheets("total orange book data") 
Set w2 = Sheets("orange book data alerts") 
With w1 
    For Each c In .Range("a2", .Range("a" & Rows.Count).End(xlUp)) 
        Set a = w2.Columns(1).Find(c.Value, lookat:=xlWhole) 
        If Not a is nothing then
            if.cells(c.row,10).value<>w2.cells(a.row(a.row,10) then

            w2.Cells(a.Row, 14).Value = "update" 
        End If 
    Next c 
End With


End Sub

Answer 1

Sorry to suggest an entirely new code to you, but the below code will do the job [this is the way i do it, tested and working]

Sub compare10()

Dim found As Integer

Worksheets("orange book data alerts").Activate
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Worksheets("total orange book data alerts").Activate
With ActiveSheet
lastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Worksheets("orange book data alerts").Activate

For i = 1 To lastRow
    found = 0
    For j = 1 To lastRow2
        If Sheets("orange book data alerts").Cells(i, 1).Value = Sheets("total orange book data alerts").Cells(j, 1).Value Then
            found = 1
            For k = 1 To 13
                If Sheets("orange book data alerts").Cells(i, k).Value <> Sheets("total orange book data alerts").Cells(j, k).Value Then
                    Sheets("orange book data alerts").Cells(i, 14).Value = "Update"
                End If
            Next k
        End If
    Next j
    If found = 0 Then
        Sheets("orange book data alerts").Cells(i, 14).Value = "New Addition"
    End If
Next i

End Sub

excel vba comparing two sheets based on unique value

1 个答案: