I have a dataset ranging from A2 through E45000 with data on companies. Some of the users have multiple vendor IDs.

I played around with This guide on extendoffice, but alas wasn't able to get it to work the way I wanted. I kept getting scripting errors, out of range errors, and the like.

My objective is to concatenate the values where there's a user that has more than one vendor ID, as shown in column F. John Smith has 12345 and 12348. It's worth noting that the emails will not change (they may have some typed in all upper case or lower case or the like JOHNSMITH@company or johnsmith@company) but the email itself will be the same exact series.

How can I achieve this in Excel using VBA or just plain excel?

CodePudding user response：

Try:

 =TEXTJOIN(", ", TRUE, FILTER($A$2:$A$5, $E2=$E$2:$E$5))

CodePudding user response：

Concatenate Unique

• In a range of a worksheet (sName), 'removes duplicates' (it doesn't) in a column uCol and at the same time concatenates the values of another column cCol, and returns the result in another worksheet (dName)

Option Explicit

Sub UniqueConcatenate()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sCols As String = "A:E"
    ' Destination
    Const dName As String = "Sheet2"
    Const dfCellAddress As String = "A1"
    Const dDelimiter As String = ", "
    ' Both
    Const cCol As Long = 1
    Const uCol As Long = 5
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion.Columns(sCols)
    Dim sData As Variant: sData = srg.Value
    Dim srCount As Long: srCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    Dim dr As Long: dr = 1 ' skip headers
    
    Dim uKey As Variant
    Dim sr As Long
    Dim cr As Long
    Dim c As Long
    
    For sr = 2 To srCount ' skip headers
        uKey = sData(sr, uCol)
        If Not IsError(uKey) Then
            If Len(uKey) > 0 Then
                If dict.Exists(uKey) Then
                    cr = dict(uKey)
                    sData(cr, cCol) = sData(cr, cCol) _
                        & dDelimiter & CStr(sData(sr, cCol))
                Else
                    dr = dr   1
                    dict(uKey) = dr
                    sData(dr, cCol) = CStr(sData(sr, cCol))
                    For c = 1 To cCount
                        If c <> cCol Then
                            sData(dr, c) = sData(sr, c)
                        End If
                    Next c
                End If
            End If
        End If
    Next sr
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName) ' worksheet, range
    Dim drg As Range: Set drg = dws.Range(dfCellAddress).Resize(dr, cCount)
    
    Dim dcdrg As Range ' format as text
    Set dcdrg = drg.Columns(cCol).Resize(dr - 1).Offset(1)
    dcdrg.NumberFormat = "@"
    
    drg.Value = sData ' write result
    
    Dim dclrrg As Range ' clear below
    Set dclrrg = drg.Resize(dws.Rows.Count - drg.Row - dr   1).Offset(dr)
    dclrrg.Clear

End Sub