Vlookup para estado duplicado

He estado buscando diferentes enfoques para solucionar mi problema, ya sea con vlookup, index, index/match, pero aún no pude resolverlo.

Estoy tratando de enumerar los mismos co-inquilinos del mismo apartamento en la misma línea que se muestra en la imagen. ¡gracias por la ayuda!

Solución del problema

Un enfoque VBA

Sub list()
 Dim wb As Workbook, ws As Worksheet
 Dim iRow As Long, iHeaderRow As Long
 Dim sApt As String, sStatus, sName As String
 Dim dict As Object
 Set dict = CreateObject("Scripting.Dictionary")
 Set wb = ThisWorkbook
 Set ws = wb.Sheets("Sheet1")
 iRow = 4 'start
 sApt = CStr(ws.Cells(iRow, 1))
 Do While Len(sApt) > 0
 sStatus = ws.Cells(iRow, 2)
 sName = ws.Cells(iRow, 3)
 If Not dict.exists(sApt) Then
 dict.Add sApt, ""
 End If
 If LCase(sStatus) = "main" Then
 dict(sApt) = sName & dict(sApt) ' add to front
 Else
 dict(sApt) = dict(sApt) & ";" & sName ' add to back
 End If
 iRow = iRow + 1
 sApt = CStr(ws.Cells(iRow, 1))
 Loop
 ' result header
 iHeaderRow = iRow + 1
 ws.Cells(iHeaderRow, 1) = "Apt"
 ws.Cells(iHeaderRow, 2) = "Main"
 iRow = iRow + 2
 ' result table
 Dim k As Variant, ar As Variant, n As Integer, m As Integer
 For Each k In dict.keys
 ws.Cells(iRow, 1) = k
 ar = Split(dict(k), ";")
 n = UBound(ar)
 ws.Cells(iRow, 2).Resize(1, n + 1) = ar
 If n > m Then m = n ' max for n
 iRow = iRow + 1
 Next
 ' complete header row
 For n = 1 To m
 ws.Cells(iHeaderRow, n + 2) = "Co-tenant"
 Next
 MsgBox "Done"
End Sub