Could anyone please tell me how to write a formula for identifying all CustomerIDs who have different products or a change of product base on the below table?

Outcome: on Column C to show the CustomerIDs 1 and 3 that have different Products

CodePudding user response：

My formula in column C is:

=COUNTIFS($A$2:$A$11;A2;$B$2:$B$11;B2)=COUNTIF$A$2:$A$11;A2)

This formula will return True/False if the Customer has bought the same product always or not. You are interested in those customer who bought different products so you want to filter by FALSE option in this case:

If you got E365 you got functions like UNIQUE and FILTER, so you could filter the range using formulas instead of manually.

CodePudding user response：

As mentioned by @Foxfire And Burns And Burns you can use Filter and Unique if you have O365. It would look like this:

=UNIQUE(FILTER(A2:A11,COUNTIFS(A2:A11,A2:A11,B2:B11,"<>"&B2:B11)<>0))

CodePudding user response：

I don't think excel function can give you a concatenation answer of non-single result. VBA can solve this.

Assumed your data will be:

• data range A2:B11 (excluded headers in A1:B1), non-blank cells assumed
• sorted by CustomerID (by any type of order) and VBA script will run along your sorted CustomerID column
• result(s) (CustomerIDs have more than 1 products) will be printed along C column from C2. Thus, make sure you clean existing data in column C.

The VBA script should be:

Sub list()

    Dim i As Integer
    Dim cell As Range
    Dim d_cust() As Variant
    
    Set customerID = ActiveSheet.Range("$A$2:" & Range("A2").End(xlDown).Address)
    Set Product = ActiveSheet.Range("$B$2:" & Range("B2").End(xlDown).Address)
    
    i = 0
    For Each cell In customerID
        On Error Resume Next
        If cell.Value <> d_cust(i - 1) And Evaluate("=SUMPRODUCT((" & customerID.Address & "=" & cell.Value & ")/(COUNTIFS(" & Product.Address & "," & Product.Address & "," & customerID.Address & "," & Chr(34) & cell.Value & Chr(34) & ") (" & customerID.Address & "<>" & cell.Value & ")))") > 1 Then
            ReDim Preserve d_cust(0 To i) As Variant
            d_cust(i) = cell.Value
            ActiveSheet.Cells((2   i), 3) = cell.Value
            i = i   1
        End If
    Next cell

End Sub

Here is the result in column C from C2, each cell 1 result. You can change result row/column as you want by changing start cell and direction here: ActiveSheet.Cells((2 i), 3) = cell.Value

CodePudding user response：

Retrieve Uniques With Multiple Items (Dictionary)

• Adjust the values in the constants section.

Option Explicit

Sub RetrieveMultiProductIds()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sFirstCellAddress As String = "A1"
    ' Destination
    Const dName As String = "Sheet1"
    Const dFirstCellAddress As String = "C1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(sName)
    
    ' Reference the source data range and write its values to an array.
    
    Dim srg As Range
    Dim srCount As Long

    Dim fCell As Range: Set fCell = ws.Range(sFirstCellAddress)
    With fCell.CurrentRegion
        Set srg = fCell.Resize(.Row   .Rows.Count _
            - fCell.Row, .Column   .Columns.Count - fCell.Column)
        srCount = .Rows.Count - 1
    End With
    If srCount < 1 Then Exit Sub ' too few rows
    Set srg = srg.Resize(srCount, 2).Offset(1)
    Dim sData As Variant: sData = srg.Value
    
    ' Store the unique ids in the keys and their corresponding values
    ' in the items of a dictionary. If for the same key a different value
    ' is encountered, flag the item with "@".
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sKey As Variant
    Dim r As Long
    Dim drCount As Long
    
    For r = 1 To srCount
        sKey = sData(r, 1)
        If dict.Exists(sKey) Then
            If dict(sKey) <> "@" Then
                If dict(sKey) <> sData(r, 2) Then
                    dict(sKey) = "@"
                    drCount = drCount   1
                End If
            End If
        Else
            dict(sKey) = sData(r, 2)
        End If
    Next r
    If drCount = 0 Then Exit Sub
    
    ' Write the flagged keys to a 2D one-based one-column array.
    
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To 1)
    r = 0
    
    For Each sKey In dict.Keys
        If dict(sKey) = "@" Then
            r = r   1
            dData(r, 1) = sKey
        End If
    Next sKey
    
    ' Write the values from the array to the destination range and clear below.
    With wb.Worksheets(dName).Range(dFirstCellAddress)
        .Resize(r).Value = dData
        .Resize(.Worksheet.Rows.Count - .Row - r   1).Offset(r).Clear
    End With
    
    MsgBox "Number of found multi-product ids: " & r, vbInformation
    
End Sub

CodePudding user response：

I think COUNTIFS solves this efficiently

=COUNTIFS($A$2:$A$8,"="&A2,$B$2:$B$8,"="&B2)