Changing two tables into a matrix - vba

Question

I have 2 spreadsheets with the data below.
Name | System 1 | System 2 | System 3 |
John | x | x | |
James| | x | x |
Peter| | x | |
Name | Process A | Process B | Process C |
John | | x | |
James| x | | x |
Peter| x | | x |
Are there any ways in VBA I can do to merge these two lists in a matrix format as below?
| Process A | Process B | Process C |
System 1 | | John | |
System 2 | James, Peter | John | James, Peter |
System 3 | James | | James |
I have coding experience but not very strong in VBA. Appreciate if anyone can give me some code samples to start with.
There are 27 systems, 21 processes and 188 names. So, it will take sometime doing it manually.
Thank you.

Answer 1

Comments are in the code, HTH.
Option Explicit
Sub Main(): On Error GoTo errMain
Dim system As Range
Dim process As Range
' Select ranges of systems and processes
Set system = Application.InputBox( _
prompt:="Go to sheet with 'system' data and select it", Title:="S Y S T E M", Type:=8)
Set process = Application.InputBox( _
prompt:="Go to sheet with 'process' data and select it", Title:="P R O C E S S", Type:=8)
' Do the merge
MergeIt system, process
Exit Sub
errMain:
MsgBox Err.Description, vbCritical
End Sub
Private Sub MergeIt(system As Range, process As Range)
Dim processData As Range
Dim processColumn As Range
Dim processName As String
Dim processUsers As Variant
Dim processValues As Variant
Dim processIndex As Integer
Dim systemData As Range
Dim systemColumn As Range
Dim systemName As String
Dim systemUsers As Variant
Dim systemValues As Variant
Dim systemIndex As String
' Add new sheet where the merged data will be stored
Dim mergedSheet As Worksheet
Set mergedSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
mergedSheet.Name = "Merged" & _
Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)
' Get process and system users as first column without the first cell
processUsers = process.Columns(1).Offset(1, 0).Resize(process.Rows.Count - 1, 1)
systemUsers = system.Columns(1).Offset(1, 0).Resize(system.Rows.Count - 1, 1)
' Get process and system data as all columns except the first one where the users are
Set processData = process.Offset(0, 1).Resize(process.Rows.Count, process.Columns.Count - 1)
Set systemData = system.Offset(0, 1).Resize(system.Rows.Count, system.Columns.Count - 1)
processIndex = 1
' Go the process data by columns.
' Add process name to result sheet and for each process column go through
' all system columns and do the merge
For Each processColumn In processData.Columns
processIndex = processIndex + 1
processName = processColumn.Cells(1).Value
mergedSheet.Rows(1).Cells(processIndex).Value = processName
processValues = processColumn.Offset(1, 0).Resize(processColumn.Rows.Count - 1, 1)
systemIndex = 1
For Each systemColumn In systemData.Columns
systemIndex = systemIndex + 1
systemValues = systemColumn.Offset(1, 0).Resize(systemColumn.Rows.Count - 1, 1)
If mergedSheet.Columns(1).Cells(systemIndex).Value = "" Then
systemName = systemColumn.Cells(1).Value
mergedSheet.Columns(1).Cells(systemIndex).Value = systemName
End If
mergedSheet.Cells(systemIndex, processIndex).Value = _
IntersectOfValues(processUsers, processValues, systemUsers, systemValues)
Next systemColumn
Next processColumn
End Sub
Private Function IntersectOfValues( _
ByVal processUsers As Variant, _
ByVal processValues As Variant, _
ByVal systemUsers As Variant, _
ByVal systemValues As Variant) As String
Dim i As Integer
Dim j As Integer
' Go through all process and system values.
' Compare names which correspond to values.
' Append the name to result if it was found in both process and system values.
For i = LBound(processValues) To UBound(processValues)
If Trim(processValues(i, 1)) = "" Then _
GoTo nextI
For j = LBound(systemValues) To UBound(systemValues)
If Trim(systemValues(j, 1)) = "" Then _
GoTo nextJ
If systemUsers(j, 1) = processUsers(i, 1) Then
IntersectOfValues = IntersectOfValues & processUsers(i, 1) & ","
Exit For
End If
nextJ:
Next j
nextI:
Next i
If Len(IntersectOfValues) = 0 Then _
Exit Function
If Right(IntersectOfValues, 1) = "," Then _
IntersectOfValues = Left(IntersectOfValues, Len(IntersectOfValues) - 1)
End Function