return only values from one column which have different values in another column

[czarmir]

hello,

I have thousands of records in my table: in column A many duplicate values, I would need to get only those unique values from column A which have different values in column B (ignore the same values in column B for corresponding value in A):



A
B


1
a


1
a


2
b



2
b


2
c


3
d


3
d


4
a


4
b



so as a result from example above, I should get only 2 and 4 on my list.
I was browsing for couple of of hours but couldn't find any solution. I guess loop is needed, but I am quite novice.

thanks

[mana]

Option Explicit


Sub test()
Dim r As Range
Dim a As Range
Dim c As Range
Dim d As Object


Set r = Cells(1).CurrentRegion

With r.Columns(3)
.Formula = "=if(countifs(a:a,a1,b:b,b1)>1,1)"
On Error Resume Next
Set a = .SpecialCells(xlCellTypeFormulas, 4)
On Error GoTo 0
.ClearContents
End With

If a Is Nothing Then Exit Sub

Set d = CreateObject("scripting.dictionary")

For Each c In a
d(c.Offset(, -2).Value) = True
Next

MsgBox Join(d.keys, vbLf)

End Sub

[czarmir]

thank you. I t works for the simple example I provided above. Unfortunately doesn't work for me, Could it be possible to return results in new sheet? I do not know if this is important: column A contains numbers in the format
00-0000000000-00-0000 and column B numbers and text (sometimes very long) let's say it's a list of 30 standard sentences which then appear in combinations:


A
B



00-0000000000-00-0000

1.test1 2.test2



00-0000000000-00-0000

1.test1 2.test2



00-0000000000-00-0001

3.test3



00-0000000000-00-0001

3.test3



00-0000000000-00-0000

1.test1 3.test3



00-0000000000-00-0002

5.test5 6.test6



00-0000000000-00-0002

5.test5



00-0000000000-00-0002

7.test7



00-0000000000-00-0000

3.test3

[mana]

Option Explicit


Sub test2()
Dim r As Range
Dim a As Range


ActiveSheet.Copy

With Cells(1).CurrentRegion.Columns("c")
.Formula = "=if(countifs(a:a,a1,b:b,b1)=1,1)"
On Error Resume Next
Set a = .SpecialCells(xlCellTypeFormulas, 4)
On Error GoTo 0
End With

If Not a Is Nothing Then a.EntireRow.Delete
Columns("b:c").ClearContents
Columns("a").RemoveDuplicates 1

End Sub

[p45cal]

Could it be possible to return results in new sheet?Try:
Sub blah()
Set myrng = Range(Cells(1), Cells(Rows.Count, 1).End(xlUp)) 'assumes start in A1 and end bottommost cell with anything in in column A.
'Set myRng = Selection 'use this instead of the line above if you want (select 2 columns of cells before running this macro).
With Sheets.Add(after:=Sheets(Sheets.Count))
.Cells(1).Resize(myrng.Rows.Count).Value = Evaluate("IF(COUNTIFS(" & myrng.Columns(1).Address(external:=True) & "," & myrng.Columns(1).Address(external:=True) & "," & myrng.Columns(2).Address(external:=True) & ",""<>"" & " & myrng.Columns(2).Address(external:=True) & ")>0," & myrng.Columns(1).Address(external:=True) & ","""")")
.Cells(1).Resize(myrng.Rows.Count).RemoveDuplicates Columns:=1, Header:=xlNo
' .Columns(1).AutoFit 'uncomment this line if you want adjusted column width.
' .UsedRange.Sort key1:=.Cells(1), Header:=xlNo 'optional to sort list (additionally any empty cell will go to the bottom of the list).
End With
End Sub
Note various possibilities in comments in the code

[czarmir]

hi,

thanks for your help. But still doesn't work for me. I attached part of my data. Out of this sheet I should get in a new sheet: only two values from column A for which values in column B are different (just one value from rows 5-7 and another from 13-15. Rows 21 and 22 (the same values in col. B) and other unique values in column A should be ignore.

regards

[p45cal]

Are the extra ones on rows 77 and 98?
If so, it turns out that there is a 255 or 256 character limit for Countif(s). B77 and B98 both contain strings longer than 256 characters.
Could you confirm these are the errant results?

[p45cal]

This seems to get round the problem:
Sub blah()
Set myRng = Range(Cells(1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 2) 'assumes start in A1 and end bottommost cell with anything in in column A.
'Set myRng = Selection 'use this instead of the line above if you want (select 2 columns of cells before running this macro).
myVals = myRng.Value
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(myVals) - 1
c1 = myVals(i, 1)
If Not dic.exists(c1) Then 'if c1 not already in dictionary:
c2 = myVals(i, 2)
For j = i + 1 To UBound(myVals)
If myVals(j, 1) = c1 And myVals(j, 2) <> c2 Then
'add to dictionary:
dic(c1) = True
Exit For
End If
Next j
End If
Next i
Sheets.Add(after:=Sheets(Sheets.Count)).Cells(1).Resize(dic.Count).Value = Application.Transpose(dic.keys)
End Sub
Note that if there are ever likely to be more than 65k results on the new sheet we'll have to rethink that last line!

re:
I guess loop is neededLooks like you were right!

[czarmir]

hi,

I randomly verified results with my sheet of 4000+ rows and it seems to be working as expected.

so big thanks for your help!