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 cellEnd Sub

"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.

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 movedataEnd SubSub 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 cellEnd Sub

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 movedataEnd SubSub 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 cellEnd SubSub EE_ChangeCellValue()Dim l As Long, rng As Range Sheets("Current").Selectl = Sheets("Current").Cells(Cells.Rows.Count, "C").End(xlUp).RowSet rng = Sheets("Current").Range("C2:C" & lrow) ' You can change this to the proper COLUMN; Starts in ROW 1For 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.DeleteNext cellCells(1, 3).SelectEnd Sub

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 movedataEnd SubSub 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 cellEE_ChangeCellValueEnd SubSub EE_ChangeCellValue()Dim l As Long, rng As Range Sheets("Current").Selectl = Sheets("Current").Cells(Cells.Rows.Count, "C").End(xlUp).RowSet rng = Sheets("Current").Range("C2:C" & lrow) ' You can change this to the proper COLUMN; Starts in ROW 1For 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.DeleteNext cellCells(1, 3).SelectEnd Sub

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.

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

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.

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

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 movedataEnd SubSub 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_ChangeCellValueEnd SubSub 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).SelectEnd Sub

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.

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).SelectcompareEnd SubSub 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 movedataEnd SubSub 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 cellEnd Sub

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-

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

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

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

Open in new window