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 needed

Looks 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!