Comparing rows of data with the same key field...

[petry_37]

HI, I am trying to compare rows of data that have the same key field identifying them. For example -

EMPLID Compensation
1234 10000
1234 10000
1234 10000
1234 10000
1245 15000
1245 15000
1245 15000

For every row where the EMPLID is the same, is the Compensation the same? Seems pretty straight forward but proving to be a bit of a struggle. Thanks in advance for your help!!

Regards
Pd

 

[MickG]

Hi, Assumed your Data in Columns "A & B".
Results in Msgbox
NB:- If for any one "Emplid" number there is more than one compensation figures the Msgbox will show that number the appropriate number of times

Sub Emplid()
Dim Rng As Range, Dn As Range, Temp As String, c As Long
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    For Each Dn In Rng
             If Dn.Value <> "" And Not .Exists(Dn.Value) Then
             .Add Dn.Value, Dn.Offset(, 1)
         Else
              If Not .Item(Dn.Value) = Dn.Offset(, 1) Then
                    Temp = Temp & Dn.Value & Chr(10)
                    c = c + 1
              End If
         End If
     
     Next
If c > 0 Then
    MsgBox "The following ""Emplid"" Numbers" & Chr(10) & "have different compemsation values" & Chr(10) & Temp
Else
    MsgBox "No Variation in Compensation Claims"
End If
End With
End Sub

Mick

 

[petry_37]

Thanks Mick, works perfectly... I was wondering if it was possible for the list to be shown on a seperate sheet so that I can use the results for vlookups, etc.???

 

[MickG]

Hi, Try this:-
Mod sheet/data to suit

Sub Emplid()
Dim Rng As Range, Dn As Range, Temp As String, c As Long
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count)
Ray(1) = """Emplid"" Variation Numbers"
c = 1
With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    For Each Dn In Rng
             If Dn.Value <> "" And Not .Exists(Dn.Value) Then
             .Add Dn.Value, Dn.Offset(, 1)
         Else
              If Not .Item(Dn.Value) = Dn.Offset(, 1) Then
              c = c + 1
              Ray(c) = Dn.Value
              End If
         End If
     
     Next
End With
With Sheets("sheet2")
    .Range("A1").WrapText = "True"
    .Columns("A").AutoFit
    .Range("A1").Resize(c).Value = Application.Transpose(Ray)
End With
End Sub

Mick

 

[petry_37]

Excellent, thanks Mick!