Excel macro problem. Auto align data of a table

I am trying to debug an excel macro which I wrote it earlier. The objective of the macro is to help me to process a table with names - raw table. It help me to shift columns to right and align the same name into one single column whenever there is a new name introduce in bottom row. I have attach raw table screenshot before the macro process, current table screenshot of what I have now, and result table screenshot of what I want to achieve.

I will attach the screenshots and macro code in my reply. Stackoverflow keep blocking me to post it when I include them.

As you can see in the current table, the macro indeed help me shifting columns to right and align the same name into one column. However, the current macro would cause Yuna in Cell F6, F7 and Angel in Cell G4, G5 go missing (as you can see what I really want to achieve in result table screenshot).

I have been debugging with ChatGPT and a few other AI but still having no success. It would be great if any expert can give me some help on this.

raw table current table

result table

Sub AlignNamesTwoPass()
    Dim wsRaw As Worksheet, wsResult As Worksheet
    Dim lastRowRaw As Long, lastColRaw As Long
    Dim dict As Object
    Dim rRaw As Long, cRaw As Long
    Dim rowData() As String
    Dim resultRow As Long, resultCol As Long
    Dim name As String

    ' Define sheet names
    Const RAW_SHEET_NAME As String = "Sheet1"
    Const RESULT_SHEET_NAME As String = "Result_Table"

    ' Set worksheets
    On Error Resume Next
    Set wsRaw = ThisWorkbook.Sheets(RAW_SHEET_NAME)
    Set wsResult = ThisWorkbook.Sheets(RESULT_SHEET_NAME)
    On Error GoTo 0

    If wsRaw Is Nothing Or wsResult Is Nothing Then
        MsgBox "Error: One or both sheets not found!", vbCritical
        Exit Sub
    End If

    ' Find last used row and column in raw data
    lastRowRaw = wsRaw.Cells(wsRaw.Rows.Count, 1).End(xlUp).Row
    lastColRaw = wsRaw.Cells(1, wsRaw.Columns.Count).End(xlToLeft).Column

    ' Clear previous results before writing new ones
    wsResult.Cells.ClearContents

    ' Initialize dictionary for column assignments
    Set dict = CreateObject("Scripting.Dictionary")

    ' **Pass 1: Collect all unique names and assign columns**
    For rRaw = lastRowRaw To 1 Step -1
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Preserve empty/null cells
            If name = "" Then name = "Null"

            ' Assign a column for each unique name
            If Not dict.exists(name) Then
                dict.Add name, dict.Count + 1  ' Assign next available column
            End If
        Next cRaw
    Next rRaw

    ' **Pass 2: Place names into their assigned columns**
    For rRaw = 1 To lastRowRaw
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Ensure empty values still shift correctly
            If name = "" Then name = "Null"

            ' Find the assigned column and place the value
            resultCol = dict(name)
            wsResult.Cells(rRaw, resultCol).Value = name
        Next cRaw
    Next rRaw

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "Final alignment completed! Names should now be correctly placed in 'Result_Table'.", vbInformation
End Sub

lastColRaw in your script doesn't catch the last column of the raw table. The below line gets the last col of the raw table.

    ' Find last used row and column in raw data
    lastColRaw = wsRaw.UsedRange.Columns.Count

Your logic for blank cells wasn't specified in OP. I've revised it as shown below, and the output now matches your expected result.

Note: For large tables, consider loading the raw data into an array for better performance.

Sub AlignNamesTwoPass()
    Dim wsRaw As Worksheet, wsResult As Worksheet
    Dim lastRowRaw As Long, lastColRaw As Long
    Dim dict As Object
    Dim rRaw As Long, cRaw As Long
    Dim rowData() As String
    Dim resultRow As Long, resultCol As Long
    Dim name As String

    ' Define sheet names
    Const RAW_SHEET_NAME As String = "Sheet1"
    Const RESULT_SHEET_NAME As String = "Result_Table"

    ' Set worksheets
    On Error Resume Next
    Set wsRaw = ThisWorkbook.Sheets(RAW_SHEET_NAME)
    Set wsResult = ThisWorkbook.Sheets(RESULT_SHEET_NAME)
    On Error GoTo 0

    If wsRaw Is Nothing Or wsResult Is Nothing Then
        MsgBox "Error: One or both sheets not found!", vbCritical
        Exit Sub
    End If

    ' Find last used row and column in raw data
    lastRowRaw = wsRaw.UsedRange.Rows.Count
    lastColRaw = wsRaw.UsedRange.Columns.Count

    ' Clear previous results before writing new ones
    wsResult.Cells.ClearContents

    ' Initialize dictionary for column assignments
    Set dict = CreateObject("Scripting.Dictionary")

    ' **Pass 1: Collect all unique names and assign columns**
    For rRaw = lastRowRaw To 1 Step -1
'        lastColRaw = wsRaw.Cells(rRaw, wsRaw.Columns.Count).End(xlToLeft).Column
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Preserve empty/null cells
            If name = "" Then name = "Null"
            ' Assign a column for each unique name
            If Not dict.exists(name) Then
                dict.Add name, dict.Count + 1  ' Assign next available column
            End If
        Next cRaw
    Next rRaw

    ' **Pass 2: Place names into their assigned columns**
    For rRaw = 1 To lastRowRaw
'        lastColRaw = wsRaw.Cells(rRaw, wsRaw.Columns.Count).End(xlToLeft).Column
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)

            ' Ensure empty values still shift correctly
            If name = "" Then name = "Null"

            ' Find the assigned column and place the value
            resultCol = dict(name)
            wsResult.Cells(rRaw, resultCol).Value = IIf(name = "Null", "", name)
        Next cRaw
    Next rRaw

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "Final alignment completed! Names should now be correctly placed in 'Result_Table'.", vbInformation
End Sub