VBA script to concatenate a cell value based on two columns - excel

Question

I'm very new to VBA and just now started to automate things in excel. I have a requirement to concatenate a cell value based on two columns. For example
In the above excel, in the A column if Doc2 exists thrice, but it has levels of 3,4 & 3 (in row number 3,4, &6 respectively). I want to concatenate values of the id into a single column like below
Based on level and Document Name, if both are same then concatenate id else do not.
Sub ConcatenateCellsIfSameValueExists()
DestRowRef = 2
CheckedCell = Cells(2, "A").Value
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row + 1
If Cells(i, "A").Value <> CheckedCell Then
tempConValues = tempConValues
Cells(DestRowRef, "C").Value = tempConValues
tempConValues = ""
DestRowRef = DestRowRef + 1
End If
tempConValues = tempConValues & " " & Cells(i, "B").Value
CheckedCell = Cells(i, "A").Value
Next
End Sub
I tried the above code, it only concatenates based on single-cell and also, repeated Document name once concatenated is not deleted. Can anyone please help here?

Answer 1

In VBA I would use a Dictionary to organize the data.
For a key, concatenate what you want to group (DocumentName and Level) and for the contents the concatenated ID's.
'Set Reference to Microsoft Scripting Runtime
Option Explicit
Sub jugate()
'Declare variables
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim D As Dictionary
Dim I As Long, V As Variant
Dim sKey As String
'set Source and Result worksheets and ranges
Set wsSrc = ThisWorkbook.Worksheets("sheet4") 'edit to real worksheet
Set wsRes = ThisWorkbook.Worksheets("sheet4") 'could put this on different sheet
Set rRes = wsRes.Cells(1, 6)
'read table into array for fastest processing
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
End With
'read into dictionary, combining like doc/level
Set D = New Dictionary
D.CompareMode = TextCompare
For I = 2 To UBound(vSrc) 'skip header row
sKey = vSrc(I, 1) & "|" & vSrc(I, 3)
If Not D.Exists(sKey) Then
D.Add Key:=sKey, Item:=vSrc(I, 2)
Else
D(sKey) = D(sKey) & vbLf & vSrc(I, 2)
End If
Next I
'create results array
ReDim vRes(0 To D.Count, 1 To 3)
'header row
For I = 1 To 3
vRes(0, I) = vSrc(1, I)
Next I
'populate data
I = 0
For Each V In D.Keys
I = I + 1
vRes(I, 1) = Split(V, "|")(0) 'doc name
vRes(I, 2) = D(V) 'concatenated ID
vRes(I, 3) = Split(V, "|")(1) 'level
Next V
'write results to worksheet
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1) + 1, columnsize:=UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
'Next lines are just for formatting
'not really necessary and not internationally aware
.Style = "output"
.EntireColumn.AutoFit
.VerticalAlignment = xlCenter
End With
End Sub
You can also obtain your desired output using Power Query, available in Windows Excel 2010+ and Office 365 Excel
Select some cell in your original table
Data => Get&Transform => From Table/Range
When the PQ UI opens, navigate to Home => Advanced Editor
Make note of the Table Name in Line 2 of the code.
Replace the existing code with the M-Code below
Change the table name in line 2 of the pasted code to your "real" table name
Examine any comments, and also the Applied Steps window, to better understand the algorithm and steps
After Close/Load, format the resultant table for Word Wrap and centering.
This formatting should persist through subsequent refreshes.
M Code
let
//Change table name in next line to your actual table name
Source = Excel.CurrentWorkbook(){[Name="Table11"]}[Content],
//set data types
#"Changed Type" = Table.TransformColumnTypes(Source,{
{"DocumentName", type text}, {"ID", type text}, {"Level", Int64.Type}}),
//group by doc name and Level
//then aggregate the text strings
#"Grouped Rows" = Table.Group(#"Changed Type", {"DocumentName", "Level"}, {
{"ID", each List.Accumulate([ID],"",
(state,current)=> if state = "" then current else state & "#(lf)" & current), Text.Type}
}),
//Place columns in desired order
#"Reordered Columns" = Table.ReorderColumns(#"Grouped Rows",{"DocumentName", "ID", "Level"})
in
#"Reordered Columns"