Here are alternatives that don't rely on 365 (which users can use this):
- VBA UDF Macro
- Power Query
1. VBA UDF Macro:
- Benefit - loads in a second even if the source data has thousands of rows
- Caveat - requires enabling macros and all changes need to be done purely in code
Instructions:
- Paste the following code into a VBA editor module
- Use it in the cell in which you want the output via either:
- 1 range for everything, e.g.
=ConcatenateKeysForItems(Table1[#All]) or =ConcatenateKeysForItems(a1:c6)
- 1 range for items and just 1 range for keys, e.g.
=ConcatenateKeysForItems(Table1[[#All],[Item]], Table1[[#All],[Key]]) or =ConcatenateKeysForItems(a1:a6, b1:b6)
- 1 range for items, 1 range for key1, and 1 range for key2, e.g.
=ConcatenateKeysForItems(Table1[[#All],[Item]],Table1[[#All],[Key]],Table1[[#All],[Key2]]) or =ConcatenateKeysForItems(a1:a6, b1:b6, c1:c6)
- Optional
- Modify the first lines to change the separators and exclusions
- If you want it to automatically update every time the source data is updated (like a native formula), then there's another code below which you can paste into the VBA editor's ThisWorkbook
Function ConcatenateKeysForItems(rng As Range, Optional rngKey1 As Range = Nothing, Optional rngKey2 As Range = Nothing) As Variant
Dim ws As Worksheet, disallowedKeys As Variant, sepInternal As String, sepExternal As String
sepInternal = " - "
sepExternal = ","
disallowedKeys = Array("0", "-1")
Set ws = rng.Worksheet
If UBound(disallowedKeys) = -1 Then
disallowedKeys = Array("")
End If
If rngKey1 Is Nothing And rngKey2 Is Nothing And rng.Columns.Count = 1 Then
' Since there's only one column, simply return the unique items
ConcatenateKeysForItems = Application.WorksheetFunction.Unique(rng.Columns(1))
Exit Function
End If
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim item As Variant, keyValue As Variant, value2 As Variant
Dim combinedValue As String
Dim row As Range
Dim colCount As Long
colCount = rng.Columns.Count
For Each row In rng.Rows
item = row.Cells(1, 1).Value
If Not dict.Exists(item) Then
dict.Add item, CreateObject("Scripting.Dictionary")
End If
If Not rngKey1 Is Nothing Then
keyValue = rngKey1.Cells(row.row - rng.row + 1, 1).Value
Else
keyValue = row.Cells(1, 2).Value ' Get keyValue from second column if rngKey1 is Nothing
End If
' Determine value2 and create combinedValue
If Not rngKey2 Is Nothing Or (colCount > 2 And rngKey1 Is Nothing) Then
If Not rngKey2 Is Nothing Then
value2 = rngKey2.Cells(row.row - rng.row + 1, 1).Value
Else
' Use the third column for value2 only if rngKey1 is Nothing and rng has more than 2 columns
value2 = row.Cells(1, 3).Value
End If
combinedValue = keyValue & sepInternal & value2
If Not dict(item).Exists(combinedValue) Then
dict(item).Add combinedValue, Array(keyValue, value2, combinedValue)
End If
Else
' If rngKey2 is Nothing and colCount <= 2, or rngKey1 is not nothing but colCount <= 2
If Not dict(item).Exists(keyValue) Then
dict(item).Add keyValue, Array(keyValue, "", "")
End If
End If
Next row
' Prepare the output array based on the conditions
Dim output() As Variant
Dim outputCols As Long
If Not rngKey2 Is Nothing Or (colCount > 2 And rngKey1 Is Nothing) Then
outputCols = 4 ' Item, Keys, Values, Key-Value Combinations
Else
outputCols = 2 ' Item, Keys
End If
ReDim output(1 To dict.Count, 1 To outputCols)
Dim k As Long: k = 1
For Each item In dict.Keys
Dim allKeys As String: allKeys = ""
Dim allValues As String: allValues = ""
Dim allCombinations As String: allCombinations = ""
Dim disallowedPrevent As Boolean
For Each keyValue In dict(item).Keys
Dim details As Variant
details = dict(item)(keyValue)
' If first entry or not disallowed
If allKeys = "" Or IsError(Application.Match(details(0) & "", disallowedKeys, 0)) Then
disallowedPrevent = False
' If not first entry or not disallowed
If allKeys <> "" And Not IsError(Application.Match(allKeys, disallowedKeys, 0)) Then
disallowedPrevent = True
End If
allKeys = IIf(disallowedPrevent, "", allKeys & IIf(allKeys = "", "", sepExternal)) & details(0)
If outputCols = 4 Then
allValues = IIf(disallowedPrevent, "", allValues & IIf(allValues = "", "", sepExternal)) & details(1)
allCombinations = IIf(disallowedPrevent, "", allCombinations & IIf(allCombinations = "", "", sepExternal)) & details(2)
End If
End If
Next keyValue
output(k, 1) = item ' Item names
output(k, 2) = allKeys ' Keys
If outputCols = 4 Then
output(k, 3) = allValues ' Values (for ranges with more than 2 columns or when rngKey2 is specified)
output(k, 4) = allCombinations ' Key-Value Combinations
End If
k = k + 1
Next item
ConcatenateKeysForItems = output
End Function
Use this to sync the output to the input - change the first line to define the input (e.g. Table1 in Sheet1) and output (e.g. E7):
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const source_rg As String = "Table1", source_sh As String = "Sheet1", target_cell As String = "E7"
Dim tbl As ListObject
On Error Resume Next ' In case there's no such table
Set tbl = Sh.ListObjects(source_rg)
On Error GoTo 0 ' Turn back on regular error handling
' Check if the changed range intersects with the table
If Not tbl Is Nothing Then
If Not Intersect(Target, tbl.Range) Is Nothing Then
' If change is within Table1, recalculate your specific cell
ThisWorkbook.Worksheets(source_sh).Range(target_cell).Calculate
End If
End If
End Sub
2. Power Query
- Benefit - simpler and doesn't require enabling macros
- Caveat - crashes Excel when the source data has many rows (thousands of lines are already overkill)
Instructions:
- Choose your original table and Data=>From Table/Range (under Get & Transform Data)
- Right click the last step and choose Insert Step After
- Replace the formula on top with (and rename Previous Step Name):
- If you have just 1 Key column, then:
= Table.Group(#"Previous Step Name", {"Item"}, {{"CombinedKeys", each Text.Combine(List.Distinct(List.Transform(Table.Column(_, "Key"), Text.From)), ","), type text}})
- If you have multiple Key columns, then:
= Table.Group(#"Previous Step Name", {"Item"}, {{"CombinedKeys", each Text.Combine(List.Distinct(List.Transform(Table.ToRecords(_), each Text.From([Key1]) & " - " & Text.From([Key2]))), ","), type text}})
- Exit Power Query and choose Keep
P.S.
If you want to filter out certain keys, like "0" and "-1", here's how:
= Table.Group(#"Previous Step Name", {"Item"}, {{"CombinedKeys", each Text.Combine(
let
currentRecords = Table.ToRecords(_),
nonZeroNonNegativeOneRecords = List.Select(currentRecords, each Text.From([Key1]) <> "0" and Text.From([Key1]) <> "-1"),
zeroOrNegativeOneRecords = List.Select(currentRecords, each Text.From([Key1]) = "0" or Text.From([Key1]) = "-1"),
validZeroOrNegativeOneRecords = List.Select(zeroOrNegativeOneRecords, each List.IsEmpty(List.Select(nonZeroNonNegativeOneRecords, (nr) => nr[Item] = _[Item]))),
combinedRecords = List.Combine({nonZeroNonNegativeOneRecords, validZeroOrNegativeOneRecords}),
combinedTexts = List.Distinct(List.Transform(combinedRecords, each Text.From([Key1]) & " - " & [Key2]))
in
combinedTexts, ","), type text}})
