Macro to compare data between 2 sheets and copy differences/new rows over

Currently I have a macro that compares two sheets and updates information from one sheet into the next. It also highlights these changes made. However, I want to also add in new rows to the 'Current' tab from the 'Import' tab based on the unique key of SR/id number. If it doesn't exist in the 'Current' tab already, it is updated to import them.

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If
       
    Next cell
End Sub

Open in new window

AckeemKAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
You can use the following code to do what you are looking for..I'm calling the second macro like i told you earlier once the first macro is complete to highlight changes...

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
    movedata
End Sub

Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If

    Next cell
    
    
End Sub

Open in new window

AckeemKAuthor Commented:
Thank you for showing me this. Is it possible to run these three macros at once one after another? I'm looking to first compare the sheets and update/import new fields and highlight them for the user, change the Severity column to be standardized and then move any row with a Status of "Closed" to the 'Closed' tab.

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
    movedata
End Sub

Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If

    Next cell
    
    
End Sub
Sub EE_ChangeCellValue()
Dim l As Long, rng As Range
 Sheets("Current").Select
l = Sheets("Current").Cells(Cells.Rows.Count, "C").End(xlUp).Row
Set rng = Sheets("Current").Range("C2:C" & lrow)  ' You can change this to the proper COLUMN; Starts in ROW 1
For Each cell In rng
    Select Case LCase(cell.Value)   ' If you have additional criteria, type it in LOWER CASE below
        Case "severity 1 - critical", "s1": cell.Value = "S1"
        Case "severity 2 - major", "s2": cell.Value = "S2"
        Case "severity 3 - minor", "s3": cell.Value = "S3"
        Case "severity 4 - cosmetic", "s4": cell.Value = "S4"
        Case Else: cell.Value = cell.Value
    End Select
    Range("A1").CurrentRegion.AutoFilter 5, "Closed"
Range("A2").CurrentRegion.Offset(1).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1)
Range("A2").CurrentRegion.EntireRow.Delete
Next cell
Cells(1, 3).Select
End Sub

Open in new window

Saurabh Singh TeotiaCommented:
You can do something like this what you are looking for...

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
    movedata
End Sub

Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If

    Next cell
    
EE_ChangeCellValue
End Sub
Sub EE_ChangeCellValue()
Dim l As Long, rng As Range
 Sheets("Current").Select
l = Sheets("Current").Cells(Cells.Rows.Count, "C").End(xlUp).Row
Set rng = Sheets("Current").Range("C2:C" & lrow)  ' You can change this to the proper COLUMN; Starts in ROW 1
For Each cell In rng
    Select Case LCase(cell.Value)   ' If you have additional criteria, type it in LOWER CASE below
        Case "severity 1 - critical", "s1": cell.Value = "S1"
        Case "severity 2 - major", "s2": cell.Value = "S2"
        Case "severity 3 - minor", "s3": cell.Value = "S3"
        Case "severity 4 - cosmetic", "s4": cell.Value = "S4"
        Case Else: cell.Value = cell.Value
    End Select
    Range("A1").CurrentRegion.AutoFilter 5, "Closed"
Range("A2").CurrentRegion.Offset(1).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1)
Range("A2").CurrentRegion.EntireRow.Delete
Next cell
Cells(1, 3).Select
End Sub

Open in new window

Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

AckeemKAuthor Commented:
I placed the macro in the 'Menu' tab for the 'Update Links' button, however, I am getting a run time error and these actions are not being done. Any assistance on this? I've attached the reporting tool so you can look at it.
DSE-Carelog-Report.xlsm
Saurabh Singh TeotiaCommented:
Okay you need to make this change in the macro-->EE_ChangeCellValue

You have this line...

Set rng = Sheets("Current").Range("C2:C" & lrow)  ' You can change this to the proper COLUMN; Starts in ROW 1

Open in new window


Change this to this...

Set rng = Sheets("Current").Range("C2:C" & l)  ' You can change this to the proper COLUMN; Starts in ROW 1

Open in new window


And it will do what you are  looking for...

Saurabh...
Saurabh Singh TeotiaCommented:
2nd change which you need to make in this macro...movedata..

You have this line...

  Set r = ws1.Range("A2:A" & lrow)

Open in new window


Change this to...

    Set r = ws1.Range("A2:A" & lr)

Open in new window


Saurabh...
AckeemKAuthor Commented:
These changes have moved the SR's with the Status of "Closed" into the 'Closed' tab. However, within the 'Current' tab now, the column header is no longer there and the Severity criteria isn't being done to standardized what is being displayed in both the "Closed" and "Current" tab after the move but before the check for closed SR's are moved into the 'Closed' sheet. Once this corrected, will highlights still occur once a new file is updated? Need help with recoding this.
AckeemKAuthor Commented:
Essentially what should happen is:

1. File is imported
2. "Update Links" button is clicked on to perform multiple macros
3. First Macro should be the comparison of the 'Import' tab and 'Current' tab to import update to any SR's in the 'Current' tab and import any new SR's. These changes should be highlighted for the user until the file is saved and closed.
4. Second Macro should be the "Severity" check to standardize that column. This should be done right after comparison check and done in the "Current" tab. If doing it upon the import (one file is imported into 'Import' tab) makes more sense, then that can be changed.
5. Lastly, the check for if the status of a SR is "Closed" should occur and be moved into the 'Closed' tab. This should be highlighted as well for the user if possible since we only have the highlighting done for changes and update with the 'Import' and 'Current' tab.
AckeemKAuthor Commented:
Are you able to assist with this action?
Saurabh Singh TeotiaCommented:
Did you try to make the changes which i suggested? As that should take care of the problem you are facing..If you are still facing any challenge..let me know so that i can work on it..
AckeemKAuthor Commented:
I believe I did and now I get a error when I try to run that macro to have all three of them run. If you can take a look at the current file and see if the changes did not occur, that would be great. It is attached.
DSE-Carelog-Report.xlsm
Saurabh Singh TeotiaCommented:
In your workbook, I wasn't able to find all the macros..so not sure where you want me to have a look..Anyways here is all the 3 codes for your reference post changes and this should do what you are looking for..

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
    movedata

End Sub


Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lr)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If

    Next cell

    EE_ChangeCellValue
End Sub

Sub EE_ChangeCellValue()
    Dim l As Long, rng As Range
    Sheets("Current").Select
    l = Sheets("Current").Cells(Cells.Rows.Count, "C").End(xlUp).Row
    Set rng = Sheets("Current").Range("C2:C" & l)  ' You can change this to the proper COLUMN; Starts in ROW 1
    For Each cell In rng
        Select Case LCase(cell.Value)   ' If you have additional criteria, type it in LOWER CASE below
        Case "severity 1 - critical", "s1": cell.Value = "S1"
        Case "severity 2 - major", "s2": cell.Value = "S2"
        Case "severity 3 - minor", "s3": cell.Value = "S3"
        Case "severity 4 - cosmetic", "s4": cell.Value = "S4"
        Case Else: cell.Value = cell.Value
        End Select
        Range("A1").CurrentRegion.AutoFilter 5, "Closed"
        Range("A2").CurrentRegion.Offset(1).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1)
        Range("A2").CurrentRegion.EntireRow.Delete
    Next cell
    Cells(1, 3).Select
End Sub

Open in new window


Saurabh...
AckeemKAuthor Commented:
Thank you for this. When I run this macro, it compares both the 'Import' and 'Current' sheets and locates the ones that changed based on the new file imported and highlights those changes. It then moves the rows with the Status of "Closed" to the closed tab. However, after that happens, the header column and several rows that were there previously no longer would. Also, the criteria standardization function for the 'Severity' column (in the Sub EE_ChangeCellValue) is not performed.

Essentially what should happen first is standardization of the criteria for the "Severity" column i.e. "S1", "S2", "S3", etc. Then it should compare the sheets and highlight any changes and then move the rows that are not "Closed" in the status field to the "Closed" tab at the empty row under the last entry (the Status change to closed should be highlighted for the user as well). Lastly, it should move any new rows based on the ID, over to the empty row under the last entry in the 'Current' tab. If there is a macro to clear the highlighted changes in the current tab and closed tab when ready then this reporting tool will be complete.
Saurabh Singh TeotiaCommented:
Their you go i changed the order of the code basis of your request..

Sub EE_ChangeCellValue()
    Dim l As Long, rng As Range
    Sheets("Current").Select
    l = Sheets("Current").Cells(Cells.Rows.Count, "C").End(xlUp).Row
    Set rng = Sheets("Current").Range("C2:C" & l)  ' You can change this to the proper COLUMN; Starts in ROW 1
    For Each cell In rng
        Select Case LCase(cell.Value)   ' If you have additional criteria, type it in LOWER CASE below
        Case "severity 1 - critical", "s1": cell.Value = "S1"
        Case "severity 2 - major", "s2": cell.Value = "S2"
        Case "severity 3 - minor", "s3": cell.Value = "S3"
        Case "severity 4 - cosmetic", "s4": cell.Value = "S4"
        Case Else: cell.Value = cell.Value
        End Select
        Range("A1").CurrentRegion.AutoFilter 5, "Closed"
        Range("A2").CurrentRegion.Offset(1).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1)
        Range("A2").CurrentRegion.EntireRow.Delete
    Next cell
    Cells(1, 3).Select
compare
End Sub

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)

    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
    movedata

End Sub


Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lr)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If

    Next cell

 
End Sub

Open in new window

AckeemKAuthor Commented:
I've inputted this macro in the "Update Links" button on the 'Menu' page. However, once I import the file and then click this button, it does not complete the actions that I asked. I've attached both the report tool and a import file so you can test for yourself. First, import the file and then update the links and look at what happens.
DSE-Carelog-Report.xlsm
emc-ticket-history-view-2015-03-31-1432-
Saurabh Singh TeotiaCommented:
Ackeemk,

I will be importing this text file manually which might not be same as your procedure as you directly import from site..Can you give me your file where you have import data pasted in the worksheet and it's not working post that as i can look in the same and fix it..

Saurabh...
AckeemKAuthor Commented:
Attached is the reporting tool with a file imported. Inside the 'Import' tab you will see this file. Essentially, it should do the steps I mentioned previously once you hit the "Update Links" button on the 'Menu' tab. You can also test it by switching some fields in rows within the current tab once all the new rows that are not closed are copied over and see what highlights once you update the links again.
DSE-Carelog-Report.xlsm
Saurabh Singh TeotiaCommented:
Their you go enclosed your workbook post changes and this should do what you are looking for..

Saurabh...
DSE-Carelog-Report.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.