PDA

View Full Version : Solved: find same value in two different lists and copy rows in new sheet



James Niven
08-04-2009, 06:13 PM
I offer my apology if this question has been presented before, but here is my issue!

The problem I am presenting is a little over my head, I have started some of the code that I was able to work out with what I want to accomplish.

I have two sheets on this spreadsheet, Master and MDO. The two sheets can be about 4000 rows each. I have the master list which is static. I receive the MDO spreadsheet once per week and what I wish to do is compare columns E, F, G and H on both sheets and if there is a difference in any cell copy this row to a new sheet named "Difference" and highlight which cell is different on the new sheet.
I only want to see the differences only and not what is the same.

Thanks

James Niven

GTO
08-04-2009, 11:23 PM
Hi James,

Will each record (row) always be matched as shown? In other words, can we just compare Master row 2 to MDO row 2 (the requested cells of course), or might we need to first locate a unique ID, such as MDO S/N?

Mark

James Niven
08-05-2009, 04:46 AM
Mark,

Thanks for the reply, the rows can not be used since each week as they install new copiers/printers, new serial numbers will show up in the MDO and not the master, so with that said, we have to use the serial number as unique ID. I hope that helps?

James Niven

GTO
08-05-2009, 06:13 AM
Hi James,

Not utterly sure on my logic, but I think maybe:


Option Explicit

Sub RetMisMatchesAndNewSerials()
Dim _
wksDif As Worksheet, _
wksMas As Worksheet, _
rngDif As Range, _
rngMas As Range, _
rngMas_Found As Range, _
rngDif_Check As Range, _
i As Long, _
bolChange As Boolean

Application.ScreenUpdating = False
With ThisWorkbook
On Error Resume Next
Application.DisplayAlerts = False
.Worksheets("Difference").Delete
Application.DisplayAlerts = True
On Error GoTo 0
.Worksheets("MDO").Copy After:=.Worksheets(.Worksheets("MDO").Index)
.Worksheets(.Worksheets("MDO").Index + 1).Name = "Difference"
Set wksDif = .Worksheets("Difference")
Set wksMas = .Worksheets("Master")

With wksMas
Set rngMas = .Range("E2:E" & .Range("E:E").Find(What:="*", _
After:=.Cells(1, "E"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row)
End With

With wksDif
Set rngDif = .Range("E2:E" & .Range("E:E").Find(What:="*", _
After:=.Cells(1, "E"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row)
If rngDif Is Nothing Or rngMas Is Nothing Then Exit Sub

For i = rngDif.Rows.Count - rngDif.Row + 1 To 2 Step -1
bolChange = False
Set rngDif_Check = .Cells(i, "E")
Set rngMas_Found = rngMas.Find(What:=rngDif_Check.Value, _
After:=rngMas(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)
If rngMas_Found Is Nothing Then
bolChange = True
rngDif_Check.Interior.ColorIndex = 6
Else
If Not rngDif_Check.Offset(, 1).Value = rngMas_Found.Offset(, 1).Value Then
bolChange = True
rngDif_Check.Offset(, 1).Interior.ColorIndex = 6
End If
If Not rngDif_Check.Offset(, 2).Value = rngMas_Found.Offset(, 2).Value Then
bolChange = True
rngDif_Check.Offset(, 2).Interior.ColorIndex = 6
End If
If Not rngDif_Check.Offset(, 3).Value = rngMas_Found.Offset(, 3).Value Then
bolChange = True
rngDif_Check.Offset(, 3).Interior.ColorIndex = 6
End If
End If

If Not bolChange Then rngDif_Check.EntireRow.Delete xlShiftUp

Next
End With
End With
Application.ScreenUpdating = True
End Sub


I did see that the mac and subnet addresses appeared 'flopped', so I wasn't sure about that. Definitely test in a junk copy of your wb first...

Off to bed for this lad, let me know if that's goofy or what you were looking to do.

Mark

James Niven
08-05-2009, 05:05 PM
Mark,

I have had a chance to look at what you have put together and it appears to work as I have asked for. I want to look into further tomorrow when I get to the office and try it on the full blown data of the 4000 rows.

I will get back to you Mark, again thanks for the effort, I aways learn more from this list everytime I visit and ask for help.

Thanks

James Niven

GTO
08-06-2009, 12:43 AM
Happy to help and you are most welcome James. Not sure about the speed, but think it should be reliable.

WINFS
08-18-2009, 04:07 PM
I have modified this worksheet to compare columns E, F, G and H on both sheets and if there is a difference in any cell, then copy all row in MDO sheet to a new sheet named "Difference" and highlight which cell is different on the new sheet.

However, the last 2 rows of MDO worksheet are always not not compared.
Can anyone help?

Thanks

GTO
08-18-2009, 05:14 PM
...However, the last 2 rows of MDO worksheet are always not not compared...

That is because the yahoo schmuck who wrote the code botched this line:

For i = rngDif.Rows.Count - rngDif.Row + 1 To 2 Step -1


...which should be:

For i = rngDif.Rows.Count + rngDif.Row - 1 To 2 Step -1


(Thank you for the catch:) )

Mark