Excel VBA: coerce information into comma separated strings

Question

I have two excel worksheets ("Sheet1" and "Sheet2"). Sheet2 contains rawdata that I want to group and present in "Sheet1" based on ID. That is, I want to coerce 'FEED' and 'NUMB' based on ID, and store 'FEED' and 'NUMB' as comma separated strings (see example data below).

This procedure needs to be dynamic, i.e. if I enter new data into Sheet2, the information presented in Sheet1 is updated automatically.

Note that I'd like to do this using VBA, in which I am an absolute beginner (Microsoft Excel 2019 and non-english). I've been trying to do this in reverse (i.e. splitting data stored according to Sheet1 to Sheet2) using VBA, however I've been unsuccessfull in my trials. I generally do not prefer working in Excel although current circumstances forces my hand at this

Sheet2

| Group | ID    | FEED  | NUMB |
|:-----:|:-----:|:-----:|:----:|
| B     | B1    | C1    | 1    |
| B     | B2    | L3    | 43   |
| B     | B3    | K12   | 101  |
| B     | B1    | G1    | 86   |
| B     | B3    | H2    | 109  |
| C     | C1    | L3    | 23   |
| C     | C2    | G1    | 24   |
| C     | C1    | L4    | 54   |
| C     | C1    | K8    | 56   |

Sheet1

| Group | ID | FEED     | NUMB     |
|:-----:|:--:|:--------:|:--------:|
| B     | B1 | C1,G1    | 1,86     |
| B     | B2 | L3       | 43       |
| B     | B3 | K12,H2   | 101,109  |
| C     | C1 | L3,L4,K8 | 23,54,56 |
| C     | C2 | G1       | 24       |

Answer 1

Please, try the next code. It returns starting from "O1". It can return anywhere you need:

Sub TestProcessCommaSep()
 'It needs a reference to 'Microsoft Scripting Runtime'
 Dim sh As Worksheet, lastR As Long, arr, arrFin, arrInt
 Dim dict As New Scripting.Dictionary, i As Long, k As Long
 
 Set sh = ActiveSheet 'use here the sheet you need
 lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
 
 arr = sh.Range("A2:D" & lastR).value   'put the range to be processed in an array
 ReDim arrFin(1 To 4, 1 To UBound(arr)) 'redim the final array to make space for maximum
 
 For i = 1 To UBound(arr) 'iterate between arr elements
    If Not dict.Exists(arr(i, 1) & "|" & arr(i, 2)) Then 'if the key does not exist:
        dict.Add arr(i, 1) & "|" & arr(i, 2), arr(i, 3) & "|" & arr(i, 4) 'it is created
    Else
        'add to the existing key the values in columns 3 and 4:
        arrInt = Split(dict((arr(i, 1) & "|" & arr(i, 2))), "|")
        dict(arr(i, 1) & "|" & arr(i, 2)) = arrInt(0) & "," & arr(i, 3) & "|" & arrInt(1) & "," & arr(i, 4)
    End If
 Next i
 'fill the final array:
 For i = 0 To dict.count - 1
    k = k + 1
    arrFin(1, k) = Split(dict.Keys(i), "|")(0)
    arrFin(2, k) = Split(dict.Keys(i), "|")(1)
    arrFin(3, k) = Split(dict.items(i), "|")(0)
    arrFin(4, k) = Split(dict.items(i), "|")(1)
 Next
 ReDim Preserve arrFin(1 To 4, 1 To k) 'keep only the elements keeping values
 'Put the header, dropping the array elements at once:
 With sh.Range("O1")
    .Resize(1, 4).value = sh.Range("A1:D1").value
    With .Offset(1).Resize(k, 4)
        .value = Application.Transpose(arrFin)
        .EntireColumn.AutoFit
    End With
 End With
End Sub

If you do not know how to add the necessary reference, please firstly run the next code, which will automatically add it. Save the workbook after that...

Sub addScrRunTimeRef()
  'Adding a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
End Sub