Modifications to code

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

Try adding/changing these:

    t = 3 ' the column to start outputting. 3 = column D, 4 = column E, etc. 
    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 ' Change Sheet1 to Office_Metadata
                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 ' Change Sheet1 to Office_Metadata
        Next
    Next

I'm looking at replacing the whole sheet with the new set of data

Then I guess your best solution would be the original one, which outputs to a new worksheet, and then just simply delete your original source worksheet.

Is there really no way to sort of refresh the sheet with the new data?

Might be possible if you posted a sample workbook, people will need to look at how the data is displayed and then come up with a solution to treat it.

sample.xlsx

Attached is the sample workbook. Rename the sheet with Office_Metadata and make sure the name "Sheet1" is present if you're using the existing code. Thanks!

Try this code:

Sub org()
    Dim a, b As Variant, i, j, k As Long, s ' a is a string, i is a long number, s is just a variable
   
    'With Sheets("Office_Metadata")
    With ActiveSheet
        .Columns(2).Clear ' clear column 2
        
        Set 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
        
        ReDim b(1 To a.SpecialCells(2).Areas.Count, 1 To a.SpecialCells(2).Areas(1).Rows.Count)
        j = 1
        k = 1
        For i = 1 To a.Rows.Count
            If a.Cells(i, 1) <> "" Then ' if cell is not empty
            
                If InStr(a.Cells(i, 1), ": ") > 0 Then ' if there is such a value
                
                    s = Split(a.Cells(i, 1), ": ") ' split by colon
                    
                    If j = 1 Then
                        b(j, k) = s(0)
                    Else
                        b(j, k) = s(1)
                    End If
                    If k = a.SpecialCells(2).Areas(1).Rows.Count Then
                        k = 1
                        j = j + 1
                    Else
                        k = k + 1
                    End If
                    
                End If
            End If
        Next i
        
        .Cells.ClearContents
        .Cells(1).Resize(UBound(b, 1), UBound(b, 2)) = b
        .Columns.AutoFit
    End With
    
End Sub

Seems like the first set of data (first 10 rows, number may vary) is missing, the rest gets displayed

Originally Posted by exlecel123

Seems like the first set of data (first 10 rows, number may vary) is missing, the rest gets displayed

Right, sorry did not look carefully into it. Try this amended code:

Sub org()
    Dim a, b As Variant, i, j, k As Long, s ' a is a string, i is a long number, s is just a variable
   
    'With Sheets("Office_Metadata")
    With ActiveSheet
        .Columns(2).Clear ' clear column 2
        
        Set 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
        
        ReDim b(1 To a.SpecialCells(2).Areas.Count + 1, 1 To a.SpecialCells(2).Areas(1).Rows.Count)
        j = 1
        k = 1
        For i = 1 To a.Rows.Count
            If a.Cells(i, 1) <> "" Then ' if cell is not empty
            
                If InStr(a.Cells(i, 1), ": ") > 0 Then ' if there is such a value
                
                    s = Split(a.Cells(i, 1), ": ") ' split by colon
                    
                    If j = 1 Then
                        b(j, k) = s(0)
                    End If
                    b(j + 1, k) = s(1)
                    If k = a.SpecialCells(2).Areas(1).Rows.Count Then
                        k = 1
                        j = j + 1
                    Else
                        k = k + 1
                    End If
                    
                End If
            End If
        Next i
        
        .Cells.ClearContents
        .Cells(1).Resize(UBound(b, 1), UBound(b, 2)) = b
        .Columns.AutoFit
    End With
    
End Sub