Can anyone help me with modifying my code to make the output appear in the same sheet? Thank you.


Sub org()
Dim a As Variant, i As Long, s ' a is a string, i is a long number, s is just a variable
   
    With Sheets("Office_Metadata")
        .Columns(2).Clear ' clear column 2
        
        a = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row) 'Returns a Range object that represents the cell at the end of the region that contains the source range
                                                                 ' Shift the focus to the last used row in the column
        
        For i = 1 To UBound(a, 1)
            If a(i, 1) <> "" Then ' if cell is not empty
            
                If InStr(a(i, 1), ": ") > 0 Then ' if there is such a value
                
                    s = Split(a(i, 1), ": ") ' split by colon
                    
                    a(i, 1) = s(0) ' first place
                    a(i, 2) = s(1) ' second place
                End If
            End If
        Next i
        .Cells(1).Resize(UBound(a, 1), UBound(a, 2)) = a 'set the cell to the column
        .Columns.AutoFit
    End With
    
    Dim myAreas As Areas, r As Range, t As Long, x, y 'Areas specify blocks of cells within a selection
    
    ' Variable "Matches" declared as Variant t
    Dim Matches
    
    'Re dimension the size of the array to 1 element
    ReDim Matches(1 To 1)
    
    'Returns a Range object that represents all the cells that match the specified type and value
    Set myAreas = Sheets("Office_Metadata").Columns(1).SpecialCells(2).Areas
    
    For i = 1 To myAreas.Count
        For Each r In myAreas(i)
        
            'Match method return the index number that is found in an array. Returns error value when it is not in an array.
            'Number will be used as a column reference for the result.
            y = Application.Match(r.Value, Matches, 0)
            
            If IsError(y) Then
            
                '"t" increased to expand the size of Match array when Error returned
                'Cells(1,t) -> heading for each category
                t = t + 1: Sheets("Sheet1").Cells(1, t).Value = r.Value
                ReDim Preserve Matches(1 To t)
                Matches(t) = r.Value
                y = t
            End If
            
            'Copy the data into Sheet1'
            Sheets("Sheet1").Cells(i + 1, y).Value = r(, 2).Value
        Next
    Next
    
End Sub