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 |
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