Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Second Request. I'm Need Your Help!!! 1

Status
Not open for further replies.
mbarnett

mbarnett

MIS
Jun 15, 2003
123
US
Hi All,

Sorry for the long desc -

I have two ranges I want to compare. Range one is in Sheet1 and range two is in Sheet2. Both ranges share the same ID number(the ID numbers are not in the same order in in the worksheets and I can't sort them, because it will effect other data in the workbook).

For each ID in Sheet1 I want the macro to find the matching ID in Sheet2 and compare the data in that row to the data in Sheet1. In both ranges there are a total of 5 columns. Column 1 contains the Unique ID and the other columns contain key data points I want to compare.

If the macro finds any mistmatch I want it to spit the mismatch per unique ID to Sheet3. I have the below macro, but I can't figure out how to modify it to do what I just described. Any suggestions would be greatly appreciated.
 
Sort by date Sort by votes
I have the below macro, but I can't figure out how to modify it to do what I just described
Can you post it, please ?
 
Upvote 0 Downvote
Try this, not tested though so no promises

Sub comparelists()
r = 1
For i = 1 To Sheets("sheet1").Cells(65536, 1).End(xlUp).Row
tofind = Sheets("sheet1").Cells(i, 1).Value
Set fnd = Sheets("sheet2").Columns(1).Find(tofind, _
lookat:=xlWhole)
If Not fnd Is Nothing Then
rw = fnd.Row
For j = 2 To 5
If Sheets("sheet1").Cells(i, j).Value <> _
Sheets("sheet2").Cells(fnd.Row, j).Value Then
Sheets("sheet3").Cells(r, 1).Value = _
Sheets("sheet1").Cells(i, 1).Value
r = r + 1
End If
Next j
End If
Next i
End Sub
 
Upvote 0 Downvote
Try the following. It firstly compares sheet1 to 2 and lists all deltas between existing records and any records missing from sheet2, then it will do the reverse but list only missing records from sheet1 as deltas for existing records have already been covered.

Code: 
Sub GetDifs()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim Sht3 As Worksheet
Dim SearchMe As Range
Dim LRowSht1 As Long
Dim LRowSht2 As Long
Dim r As Long
Dim y As Long
Dim z As Long
Dim fnd As Long


Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")
Set Sht3 = Sheets("Sheet3")

LRowSht1 = Sht1.Cells(Rows.Count, "A").End(xlUp).Row
LRowSht2 = Sht2.Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

'Firstly search Sheet2 for all the values on Sheet1 and list
'both deltas and missing records

Set SearchMe = Sht2.Range("A1:A" & LRowSht2)
y = 1

For r = LRowSht1 To 1 Step -1
Set findme = Sht1.Cells(r, 1)
    With SearchMe
        Set found = .Find(what:=findme, LookIn:=xlValues)
            If Not found Is Nothing Then
                fnd = 0
                For z = 1 To 4
                   If found.Offset(0, z).Value <> findme.Offset(0, z).Value Then
                      fnd = fnd + 1
                   End If
                Next z
                
                If fnd > 0 Then
                      findme.Resize(1, 4).Copy Sht3.Cells(y, 1)
                      y = y + 1
                End If
                
            Else: findme.Resize(1, 4).Copy Sht3.Cells(y, 1)
                  y = y + 1
            End If
    End With
Next r

'Now search Sheet1 for all the values on Sheet2 and list
'only missing records

Set SearchMe = Sht1.Range("A1:A" & LRowSht1)

For r = LRowSht2 To 1 Step -1
Set findme = Sht2.Cells(r, 1)
    With SearchMe
        Set found = .Find(what:=findme, LookIn:=xlValues)
            If found Is Nothing Then
                findme.Resize(1, 4).Copy Sht3.Cells(y, 1)
                y = y + 1
            End If
    End With
Next r

Application.ScreenUpdating = True

End Sub

Regards
Ken..........

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Upvote 0 Downvote
Just noticed the wordwrap, and have tweaked slightly to give you a note against each record that tells you whether it has been flagged because it is a delta, or whether it is missing, and if missing, where from.

Code: 
Sub GetDifs()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim Sht3 As Worksheet
Dim SearchMe As Range
Dim LRowSht1 As Long
Dim LRowSht2 As Long
Dim r As Long
Dim y As Long
Dim z As Long
Dim fnd As Long


Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")
Set Sht3 = Sheets("Sheet3")

LRowSht1 = Sht1.Cells(Rows.Count, "A").End(xlUp).Row
LRowSht2 = Sht2.Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

'Firstly search Sheet2 for all the values on Sheet1 and list
'both deltas and missing records

Set SearchMe = Sht2.Range("A1:A" & LRowSht2)
y = 1

For r = LRowSht1 To 1 Step -1
Set findme = Sht1.Cells(r, 1)
    With SearchMe
        Set found = .Find(what:=findme, LookIn:=xlValues)
            If Not found Is Nothing Then
                fnd = 0
                For z = 1 To 4
                   If found.Offset(0, z).Value <> _
                      findme.Offset(0, z).Value Then
                        fnd = fnd + 1
                   End If
                Next z
                
                If fnd > 0 Then
                      findme.Resize(1, 4).Copy Sht3.Cells(y, 1)
                      Sht3.Cells(y, 5).Value = "Deltas Between 2 records"
                      y = y + 1
                End If
                
            Else: findme.Resize(1, 4).Copy Sht3.Cells(y, 1)
                  Sht3.Cells(y, 5).Value = "Missing From Sheet2"
                  y = y + 1
            End If
    End With
Next r

'Now search Sheet1 for all the values on Sheet2 and list
'only missing records

Set SearchMe = Sht1.Range("A1:A" & LRowSht1)

For r = LRowSht2 To 1 Step -1
Set findme = Sht2.Cells(r, 1)
    With SearchMe
        Set found = .Find(what:=findme, LookIn:=xlValues)
            If found Is Nothing Then
                findme.Resize(1, 4).Copy Sht3.Cells(y, 1)
                Sht3.Cells(y, 5).Value = "Missing From Sheet1"
                y = y + 1
            End If
    End With
Next r

Application.ScreenUpdating = True

End Sub

Regards
Ken................

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Upvote 0 Downvote
Thanks Guys,

Hey KW could you dim findme as range??
 
Upvote 0 Downvote
Oops - missed that one. Serves me right for not using Option Explicit :-(

Yes - Dim it as a range

Regards
Ken...............

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Upvote 0 Downvote
KenWright,

You are a life saver. I have ons small question to ask. For each Unique ID I'm comparing data in the columns next to the ID. Instead of showing the data that is missing. Can it be possible to adjust the code to subtract the columns and report the results on sheet three.


Thanks
Mike
 
Upvote 0 Downvote
Got me confused there. How can I subtract data for a record I have flagged as missing? using the following example of how Sheet3 would currently look with the data as presented in 1 and 2, what would you want to see in Sheet3
(Got a pretty hectic day ahead of me today, so may not see this till I get home later - UK Time)

Sheet1
1001 2 4 6 8
1002 8 9 8 7
1003 4 5 6 7
1005 5 4 3 2

Sheet2
1001 2 4 6 8
1002 3 4 5 6
1004 4 4 4 5
1005 5 4 3 2

Sheet3
1002 3 4 5 6 << Deltas
1003 4 5 6 7 << Missing from Sheet2
1004 4 4 4 5 << Missing from Sheet1

Regards
Ken..............

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Upvote 0 Downvote
Hi KW,

In the example below both sheet1 and sheet2 contain the same Ubique ID, but may have different Notional or different B Notional and every thing else matches. So if Apple on Sheet2 has BNotional of 300. I want Sheet3 to show the Unique ID of Apple (shared on both sheets) and the diff it finds btw Notional/BNotional -

Shhet1
Unique ID Notional BNotional
Apple 100 500
Pear 200 300

Sheet2
Unique ID Notional BNotional
Apple 100 100
Pear 200 300

Results - Sheet3
Unique ID Notional BNotional
Apple 0 400


Thanks Again fo all your help-

Mike
 
Upvote 0 Downvote
OK I got you:-

Code: 
Sub GetDifs()

Sub GetDifs()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim Sht3 As Worksheet
Dim SearchMe As Range
Dim findme As Range
Dim LRowSht1 As Long
Dim LRowSht2 As Long
Dim r As Long
Dim y As Long
Dim z As Long
Dim fnd As Long


Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")
Set Sht3 = Sheets("Sheet3")

LRowSht1 = Sht1.Cells(Rows.Count, "A").End(xlUp).Row
LRowSht2 = Sht2.Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

'Firstly search Sheet2 for all the values on Sheet1 and list
'both deltas and missing records

Set SearchMe = Sht2.Range("A1:A" & LRowSht2)
y = 1

For r = LRowSht1 To 1 Step -1
Set findme = Sht1.Cells(r, 1)
    With SearchMe
        Set found = .Find(what:=findme, LookIn:=xlValues)
            If Not found Is Nothing Then
                fnd = 0
                For z = 1 To 4
                   If found.Offset(0, z).Value <> _
                      findme.Offset(0, z).Value Then
                        fnd = fnd + 1
                   End If
                Next z
                
                If fnd > 0 Then
                      Sht3.Cells(y, 1).Value = findme.Value
                      
                      For x = 1 To 4
                          Sht3.Cells(y, x + 1).Value = _
                             findme.Offset(0, x).Value - _
                             found.Offset(0, x).Value
                      Next x
                      
                      Sht3.Cells(y, 6).Value = _
                          "Deltas Between 2 records (Sht1 - Sht2)"
                          
                      y = y + 1
                End If
                
            Else: findme.Resize(1, 5).Copy Sht3.Cells(y, 1)
                  Sht3.Cells(y, 6).Value = "Missing From Sheet2"
                  y = y + 1
            End If
    End With
Next r

'Now search Sheet1 for all the values on Sheet2 and list
'only missing records

Set SearchMe = Sht1.Range("A1:A" & LRowSht1)

For r = LRowSht2 To 1 Step -1
Set findme = Sht2.Cells(r, 1)
    With SearchMe
        Set found = .Find(what:=findme, LookIn:=xlValues)
            If found Is Nothing Then
                findme.Resize(1, 5).Copy Sht3.Cells(y, 1)
                Sht3.Cells(y, 6).Value = "Missing From Sheet1"
                y = y + 1
            End If
    End With
Next r

Application.ScreenUpdating = True

End Sub

Regards
Ken..........

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Upvote 0 Downvote
Hi,

It works great!!!! Thanks Again for all your help!!!!
 
Upvote 0 Downvote
My pleasure - appreciate the feedback :)

Regards
Ken............

----------------------------------------------------------------------------
[peace]It's easier to beg forgiveness than ask permission[2thumbsup]

----------------------------------------------------------------------------
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Question
CTRL + BREAK from second macro button
Replies
5
Views
979
strongm
strongm
SLW89
  • Locked
  • Question
VBA newbie needs help
Replies
4
Views
633
Andrzejek
Andrzejek
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
694
combo
combo
arvarr
  • Locked
  • Question
Excel Help - Worksheets by UserID 3
2
Replies
39
Views
1K
arvarr
arvarr
simc22
  • Locked
  • Question
Help with VBA find loop?
Replies
5
Views
325
strongm
strongm

Part and Inventory Search

Sponsor

Back
Top