Code to fill matrix with 'yes' or 'no' based on input - vba

Question

I have a matrix in an Excel sheet. In the first column are names of computers and in the other rows, I have users who are using it. For each computer there could be one associated user or two users and so on.
I wish to create a matrix of computers in the column and the all the users in the row and have VBA code to search the sheet, and if the user uses that computer, the output should be yes, else no.
Main Sheet
Computer A Dev Priya Rakesh Joseph
Computer B Rakesh Joseph
Computer C John Nisha Dev
Output Sheet
Computers Dev Priya Rakesh Joseph John Nisha
Computer A Y Y Y Y N N
Computer B N N Y Y N N
Computer C Y N N N Y Y

Answer 1

Rename sheet to 'Main' and copy data to it start from range A1.
Beware blank cell because I check end of row and column by check cell is "".
Rename other sheet to 'Output'.
Copy my code then run.
Note: Output sheet will clear all the time you run this macro.
Sub createMatrix()
Dim i As Long
Dim j As Long
Dim k As Long
Dim rngFind As Range
' Clear all contents in sheets output
Sheets("Output").Activate
Sheets("Output").Cells.ClearContents
i = 0
j = 1
k = 1
Do While Sheets("Main").Range("A1").Offset(i).Value <> ""
' Insert computer name to output sheet
Sheets("Output").Range("A2").Offset(i).Value = Sheets("Main").Range("A1").Offset(i).Value
Do While Sheets("Main").Range("A1").Offset(i, j).Value <> ""
' Check name is exists?
Set rngFind = Rows("1:1").Find(what:=Sheets("Main").Range("A1").Offset(i, j).Value, LookAt:=xlWhole)
If rngFind Is Nothing Then
' If not exists paste new name
Sheets("Output").Range("A1").Offset(0, k).Value = Sheets("Main").Range("A1").Offset(i, j).Value
' Mark use as 'Y'
Sheets("Output").Range("A1").Offset(i + 1, k).Value = "Y"
k = k + 1
Else
' Mark use as 'Y'
rngFind.Offset(i + 1).Value = "Y"
End If
j = j + 1
Loop
i = i + 1
j = 1
Loop
' This loop for Mark 'N'
i = 0
j = 1
Do While Sheets("Output").Range("A2").Offset(i).Value <> ""
Do While Sheets("Output").Range("A1").Offset(0, j).Value <> ""
' If found blank cell Mark 'N'
If Sheets("Output").Range("A2").Offset(i, j).Value = "" Then
Sheets("Output").Range("A2").Offset(i, j).Value = "N"
End If
j = j + 1
Loop
i = i + 1
j = 1
Loop
End Sub
Sample main sheet and output

Answer 2

This version creates a new sheet
Option Explicit
Public Sub TheMatrixReloaded() 'There is no spoon
Const FR As Long = 1: Const FC As Long = 2
Dim ws1 As Worksheet, ws2 As Worksheet, lr As Long, ur As Range
Dim ud As Object, cel As Range, i As Long
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
With ws1.UsedRange
lr = ws1.Cells(.Rows.Count + .Row + 1, FC - 1).End(xlUp).Row
Set ur = ws1.Range(ws1.Cells(FR + 1, FC), ws1.Cells(lr, .Columns.Count + .Column - 1))
End With
Set ud = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Set ws2 = ThisWorkbook.Worksheets.Add(After:=ws1)
ws1.Range(ws1.Cells(FR, FC - 1), ws1.Cells(lr, FC - 1)).Copy ws2.Cells(FR, FC - 1)
For Each cel In ur
With cel
If Len(.Value2) > 0 Then
If Not ud.Exists(.Value2) Then
ud.Add .Value2, FC + i
ws2.Cells(FR, FC + i).Value2 = .Value2
ws2.Cells(.Row, FC + i).Value2 = "Y": i = i + 1
Else
ws2.Cells(.Row, ud(.Value2)).Value2 = "Y"
End If
End If
End With
Next
With ws2.UsedRange
Set ur = ws2.Range(ws2.Cells(FR + 1, FC), ws2.Cells(.Rows.Count, .Columns.Count))
Set ur = ur.SpecialCells(xlCellTypeBlanks)
End With
ur.Value2 = "N": ur.Font.Color = RGB(177, 177, 177)
ws2.Columns(1).AutoFit: ws2.UsedRange.HorizontalAlignment = xlCenter
ws2.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Application.ScreenUpdating = True
End Sub