- Spreadsheets
- VBA
- Microsoft Excel
- Visual Basic Classic
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
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
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
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
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
DSE-Carelog-Report.xlsm
Okay you need to make this change in the macro-->EE_ChangeCellValue
You have this line...
Change this to this...
And it will do what you are looking for...
Saurabh...
You have this line...
Set rng = Sheets("Current").Range("C2:C" & lrow) ' You can change this to the proper COLUMN; Starts in ROW 1
Change this to this...
Set rng = Sheets("Current").Range("C2:C" & l) ' You can change this to the proper COLUMN; Starts in ROW 1
And it will do what you are looking for...
Saurabh...
2nd change which you need to make in this macro...movedata..
You have this line...
Change this to...
Saurabh...
You have this line...
Set r = ws1.Range("A2:A" & lrow)
Change this to...
Set r = ws1.Range("A2:A" & lr)
Saurabh...
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.
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.
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..
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
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..
Saurabh...
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
Saurabh...
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.
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).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
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-
DSE-Carelog-Report.xlsm
emc-ticket-history-view-2015-03-31-1432-
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...
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...
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
DSE-Carelog-Report.xlsm
Their you go enclosed your workbook post changes and this should do what you are looking for..
Saurabh...
DSE-Carelog-Report.xlsm
Saurabh...
DSE-Carelog-Report.xlsm
-
![]()
received a Solution
Comparison of Values between two sheets -
![]()
wrote an Article
![]()
A Guide to Writing Understandable and Maintainable VBA Code
-
![]()
created a Video
![]()
Using Automation to Control Excel from Access
-
Explore Cloud Class® ![]()
Microsoft Excel 2016 Data Analysis
Premium Content
You need an Expert Office subscription to comment.Start Free Trial