Using a common value, display unique values that relate/correspond to it

[chive90]

I have multiple Names in Column A that correlate to an Account Name in Column C.
Column A and Column C have many duplicate values.

I want to be able to identify where the same name in Column A has different entries in Column C
e.g.

Column A	Column C
John Smith	JSmith1
John Smith	JSmith2
John Smith	JSmith3
John Smith	JSmith1
John Smith	JSmith4

So in the above scenario, I would get a return that shows John Smith has 4 unique accounts, and it would list what they are.

I don't care about multiple Column A entries if they have the same unique value in Column C, e.g.

Column A	Column C
Joe Bloggs	JBloggs1
Joe Bloggs	JBloggs1
Joe Bloggs	JBloggs1

These results can be ignored as they only have 1 unique match.


What is the best formula / pivot approach to use to display the data I am after? Ideally I would like to be able to filter to see where a value in Column A has greater than 1 unique corresponding entry in Column C, it will then show me the Column A name with the unique Column C values that correspond to it.

Thanks

 

[Anfinsen]

Hello,
The filter formula would be a great way to accomplish this. See below for a link to use this.

How to use the FILTER function

The FILTER function lets you extract values/rows based on a condition or criteria. It is in the Lookup and reference category and is only available to Exce

www.get-digital-help.com

 

[Fluff]

That function does not exist in 2016, just 2021 &365.

 

[Anfinsen]

Hey Chive,
As Fluff pointed out, the filter formula isn't available in 2016, so I thought I would offer an alternative solution.
The code below will add your unique values to a new sheet.

Sub ExtractUniqueValues()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim dict As Object
    Dim cell As Range
    Dim key As Variant
    Dim value As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim newRow As Long
    
    ' Define your source worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your source sheet name
    
    ' Create a new worksheet for storing unique values
    Set wsNew = ThisWorkbook.Sheets.Add
    wsNew.Name = "UniqueValues"
    
    ' Find the last row of data in column A
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' Copy values from column A to the new sheet starting from row 1
    wsSource.Range("A1:A" & lastRow).Copy Destination:=wsNew.Range("A2")
    
    ' Initialize a dictionary object to store unique values
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Loop through each row in column A of the new sheet
    For i = 1 To lastRow
        key = wsNew.Cells(i + 1, 1).value ' Get the value in column A of the new sheet
        
        ' Check if the key already exists in the dictionary
        If Not dict.Exists(key) Then
            dict.Add key, True ' Add the key to the dictionary
        End If
    Next i
    
    ' Loop through each unique key in the dictionary
    newRow = 1 ' Start writing from row 1
    For Each key In dict.Keys
        ' Find matching values in column C of the source sheet
        For Each cell In wsSource.Range("A1:A" & lastRow)
            If cell.value = key Then
                ' If the value in column A matches the key, copy the corresponding value from column C to the new sheet
                newRow = newRow + 1 ' Move to the next row in the new sheet
                wsNew.Cells(newRow, 2).value = cell.Offset(0, 2).value ' Offset by 2 columns to get column C
            End If
        Next cell
    Next key
    
    ' Remove duplicates in the new sheet
    With wsNew
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End With
    
    ' Clean up
    Set wsSource = Nothing
    Set wsNew = Nothing
    Set dict = Nothing
End Sub

 

[chive90]

Hey Chive,
As Fluff pointed out, the filter formula isn't available in 2016, so I thought I would offer an alternative solution.
The code below will add your unique values to a new sheet.

Sub ExtractUniqueValues()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim dict As Object
    Dim cell As Range
    Dim key As Variant
    Dim value As Variant
    Dim lastRow As Long
    Dim i As Long
    Dim newRow As Long
   
    ' Define your source worksheet
    Set wsSource = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your source sheet name
   
    ' Create a new worksheet for storing unique values
    Set wsNew = ThisWorkbook.Sheets.Add
    wsNew.Name = "UniqueValues"
   
    ' Find the last row of data in column A
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
   
    ' Copy values from column A to the new sheet starting from row 1
    wsSource.Range("A1:A" & lastRow).Copy Destination:=wsNew.Range("A2")
   
    ' Initialize a dictionary object to store unique values
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' Loop through each row in column A of the new sheet
    For i = 1 To lastRow
        key = wsNew.Cells(i + 1, 1).value ' Get the value in column A of the new sheet
       
        ' Check if the key already exists in the dictionary
        If Not dict.Exists(key) Then
            dict.Add key, True ' Add the key to the dictionary
        End If
    Next i
   
    ' Loop through each unique key in the dictionary
    newRow = 1 ' Start writing from row 1
    For Each key In dict.Keys
        ' Find matching values in column C of the source sheet
        For Each cell In wsSource.Range("A1:A" & lastRow)
            If cell.value = key Then
                ' If the value in column A matches the key, copy the corresponding value from column C to the new sheet
                newRow = newRow + 1 ' Move to the next row in the new sheet
                wsNew.Cells(newRow, 2).value = cell.Offset(0, 2).value ' Offset by 2 columns to get column C
            End If
        Next cell
    Next key
   
    ' Remove duplicates in the new sheet
    With wsNew
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End With
   
    ' Clean up
    Set wsSource = Nothing
    Set wsNew = Nothing
    Set dict = Nothing
End Sub

Hey - thanks for this, appreciate you taking the time.

I probably should have mentioned that this is across a couple hundred thousand rows of data. I tried running the above but it was still trying to run after 90 minutes at which point I had to kill it.

Are there any formula based alternatives I could try instead that perhaps won't be as impacted by the size of the dataset?

Thank you

 

[Anfinsen]

Hey - thanks for this, appreciate you taking the time.

I probably should have mentioned that this is across a couple hundred thousand rows of data. I tried running the above but it was still trying to run after 90 minutes at which point I had to kill it.

Are there any formula based alternatives I could try instead that perhaps won't be as impacted by the size of the dataset?

Thank you

How many columns are there? how many rows?

 

[Anfinsen]

How many columns are there? how many rows? an example of the actual sheet would be helpful.

 

[chive90]

How many columns are there? how many rows?

3 columns and ~400,000 rows

Name is in A
Account Name is in C

If the additional column is causing an issue, it can be deleted so Account Name ends up in B.

 

[chive90]

Is anyone able to advise whether this is possible using a formula? Thanks