Here's a VBA code that combines the descriptions for each Team (Column A is Team and Column B Description) and creates a list of unique departments with their combined descriptions in the result sheet:
Sub CombineDescriptionsByDepartment()
Dim dataSheet As Worksheet
Dim resultSheet As Worksheet
Dim dataRange As Range
Dim departmentColumn As Range
Dim descriptionColumn As Range
Dim departments As Variant
Dim descriptions As Variant
Dim department As Variant
Dim description As Variant
Dim combinedDescriptions As Object
Dim rowIndex As Long
Dim resultTable As Range
Dim resultRowIndex As Long
' Set the data sheet and result sheet references
Set dataSheet = ThisWorkbook.Sheets("Sheet1") ' Replace with your actual data sheet name
Set resultSheet = ThisWorkbook.Sheets("Sheet2") ' Replace with your actual result sheet name
' Set the data range references
Set dataRange = dataSheet.Range("A1:B" & Selection.Rows.Count) ' Adjust the range as per your data
' Get the department and description columns from the data range
Set departmentColumn = dataRange.Columns(1)
Set descriptionColumn = dataRange.Columns(2)
' Get unique departments and descriptions from the columns
departments = departmentColumn.Value
descriptions = descriptionColumn.Value
' Create a dictionary to store combined descriptions for each department
Set combinedDescriptions = CreateObject("Scripting.Dictionary")
' Loop through the data and combine descriptions for each department
For rowIndex = 2 To UBound(departments)
department = departments(rowIndex, 1)
description = descriptions(rowIndex, 1)
If Not combinedDescriptions.Exists(department) Then
combinedDescriptions(department) = description
Else
combinedDescriptions(department) = combinedDescriptions(department) & " " & description
End If
Next rowIndex
' Clear the result sheet
resultSheet.UsedRange.Clear
' Write the results to the result sheet
resultRowIndex = 1
For Each department In combinedDescriptions.keys
Set resultTable = resultSheet.Range("A" & resultRowIndex)
' Write the department name
resultTable.Value = department
' Write the combined description
resultTable.Offset(0, 1).Value = combinedDescriptions(department)
' Move to the next result row
resultRowIndex = resultRowIndex + 1
Next department
MsgBox "Description combination completed."
End Sub
