0

I have two lists in my workbook currently

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

Thank you. Appreciate all the help I can have.

4
  • Different sheets? How many records? Are the names in the same order for both lists? Any records exist in one list but not the other? What have you tried already? Where are you stuck? This isn't in a relational database? Feb 19, 2015 at 13:08
  • If these are two sheets in an Excel file, then your best options are 1) A dirty manual option that makes sense if you don't have two many rows (John, James, Peter) and you only want to do this once OR 2) VBA. How complicated is your actual data and do you need to do this a lot? Feb 19, 2015 at 13:28
  • I can copy them into different sheets. The end result will be a 21x27 matrix. There are 188 names ordered alphabetically. it is not a relational db, this is an excel file. I am trying to find out if we can do it via excel functions.
    – Wilson
    Feb 20, 2015 at 2:41
  • If via VBA, i am afraid i am not strong in it, so would really appreciate if you can point me to some sample code snippets. Thank you.
    – Wilson
    Feb 20, 2015 at 2:42

1 Answer 1

0

The given code does what you want. I did not expect it to be this long, sorry for that. But I think this is quite efficient. Sorry for no comments, but I accidentally spent more time on it that I expected. So, for you this might be difficult to understand the code. Anyways, questions are welcome.

Essentially, you are asked to select the 1st table, then the 2nd (no matter in which worksheet). Then the code traces the x values from a column in the first table and writes names which has x in that column into a thing called "dictionary". Then it's time for the 2nd table - if there is an x next to some name, the value in the dictionary of that name is changed to 1. Then, all the names which have the value of 1 in the dictionary are put to the str string, and this string is outputted to the results array Array3. This process repeats for every column in both input tables. Finally, results array is outputed to the newly created worksheet.

Alt + F11 opens the VBE. Insert > Module inserts a new module. The code should pe pasted to this module. When you have pasted the code, you can close the VBE window. Alt + F8 opens macros list.

Sub Join_tables()
Dim ws As Worksheet
Dim Array1 As Variant
Dim Array2 As Variant
Dim Array3() As Variant
Dim dict As Object
Dim dicKey As Variant
Dim str As String
Dim j As Long, k As Long, i As Long 'counters
Array1 = Application.InputBox("Select the 1st table.", "Get List", Type:=64)
Array2 = Application.InputBox("Select the 2nd table.", "Get List", Type:=64)
ReDim Array3(1 To UBound(Array1, 2), 1 To UBound(Array2, 2))
Set dict = CreateObject("Scripting.Dictionary")

For j = 2 To UBound(Array3, 1)
    Array3(j, 1) = Array1(1, j)
    For k = 2 To UBound(Array3, 2)
        If Array3(1, k) = vbNullString Then Array3(1, k) = Array2(1, k)

        For i = 2 To UBound(Array1, 1)
            If Array1(i, j) = "x" Then
                On Error Resume Next
                dict.Add Array1(i, 1), 0
                On Error GoTo 0
                If Err.Number = 457 Then Err.Clear
            End If
        Next

        For i = 2 To UBound(Array2, 1)
            If Array2(i, k) = "x" Then
                If dict.exists(Array2(i, 1)) Then
                    dict.Item(Array2(i, 1)) = 1
                End If
            End If
        Next

        str = vbNullString
        For Each dicKey In dict.keys
            If dict.Item(dicKey) = 1 Then
                str = str & dicKey & ", "
            End If
        Next
        dict.RemoveAll
        If str <> vbNullString Then str = Left(str, Len(str) - 2)

        Array3(j, k) = str

    Next 'k
Next 'j

Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Range("A1").Resize(UBound(Array3, 1), UBound(Array3, 2)) = Array3

Set ws = Nothing
Set dict = Nothing
End Sub
0

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .