Convert Each Data set into 1 row

Question

Im trying to make a macro on Excel using VBA that will transpose each Data set into 1 row only.

Initial Format of Table

No.               1
Code              A1B1
Date              10/25/21
No.               2
Code              A2B2
Date              10/26/21

Outcome should be like this in Sheet2

No.       Code          Date
1         A1B2        10/25/21
2         A2B2        10/26/21

I tried to copy Row that contain "No.". But I want it to be extracted to cell B2. Where should I start?

    Sub CopyNo()
  Dim LastRow As Long
  LastRow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
  With Worksheets("Sheet2").Range("A1:A" & LastRow)
    Worksheets("Sheet1").Range("A1:A" & LastRow).EntireRow.Copy .Range("A1")
    With .Offset
      .Replace "No.", "=No.", xlPart
      On Error Resume Next
      .Offset(1).SpecialCells(xlConstants).EntireRow.Delete
      On Error GoTo 0
      .Replace "=No.", "No.", xlPart
    End With
  End With
End Sub

Answer 1

This is a type of Pivot Table, but with no aggregation of the results (Not something that can be done in the regular Pivot Tables for Excel)

But you can do this in Power Query, available in Windows Excel 2010+ and Office 365

To use Power Query

• Select some cell in your Data Table
• Data => Get&Transform => from Table/Range
• When the PQ Editor opens: Home => Advanced Editor
• Make note of the Table Name in Line 2
• Paste the M Code below in place of what you see
• Change the Table name in line 2 back to what was generated originally.
• Read the comments in the code and explore the Applied Steps to understand the algorithm

M Code

let

//Read in the data
//Change table name in next line to actual table name in your worksheet
    Source = Excel.CurrentWorkbook(){[Name="Table22"]}[Content],

//Custom function
//see credits for explanation
    pivot = fnPivotAll(Source, "Column1","Column2"),

//set data types
    #"Changed Type" = Table.TransformColumnTypes(pivot,{
            {"No.", Int64.Type}, 
            {"Code", type text},
            {"Date", type date}})
in
    #"Changed Type"

Note that you will need to use a custom function for this solution

• To enter the custom function:
  • Data => GetData => From other sources => Blank Query
  • When the PQ Editor opens: Home => Advanced Editor
    • Replace the code with the code below
    • over on the right hand menu, change Query Name to fnPivotAll
    • See the link in the credits for understanding the algorithm and reason for doing it this way.

//credit: Cam Wallace  https://www.dingbatdata.com/2018/03/08/non-aggregate-pivot-with-multiple-rows-in-powerquery/
//rename fnPivotAll

(Source as table,
    ColToPivot as text,
    ColForValues as text)=> 

let
     PivotColNames = List.Buffer(List.Distinct(Table.Column(Source,ColToPivot))),
     #"Pivoted Column" = Table.Pivot(Source, PivotColNames, ColToPivot, ColForValues, each _),
 
    TableFromRecordOfLists = (rec as record, fieldnames as list) =>
    
    let
        PartialRecord = Record.SelectFields(rec,fieldnames),
        RecordToList = Record.ToList(PartialRecord),
        Table = Table.FromColumns(RecordToList,fieldnames)
    in
        Table,
 
    #"Added Custom" = Table.AddColumn(#"Pivoted Column", "Values", each TableFromRecordOfLists(_,PivotColNames)),
    #"Removed Other Columns" = Table.RemoveColumns(#"Added Custom",PivotColNames),
    #"Expanded Values" = Table.ExpandTableColumn(#"Removed Other Columns", "Values", PivotColNames)
in
    #"Expanded Values"

`

Answer 2

Transpose Vertical Data

• It is assumed that your data is contiguous (no empty rows (or empty columns)) and it starts in cell A1.
• It is assumed that the destination headers are already written (in this case in the range A1:C1).
• Adjust the values in the constants section.

Option Explicit

Sub TransposeVerticalData()
    Const ProcTitle As String = "Transpose Vertical Data"
    
    ' Source
    Const sName As String = "Sheet1"
    Const sCriteriaList As String = "No.,Code,Date"
    Const shColumn As Long = 1 ' Header Column
    Const svColumn As Long = 2 ' Value Column
    ' Destination
    Const dName As String = "Sheet2"
    Const dFirst As String = "A2"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source (Worksheet, Range, Rows Count, Data Array, Criteria Array)
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion.Resize(, svColumn)
    Dim srCount As Long: srCount = srg.Rows.Count
    Dim sData As Variant: sData = srg.Value
    Dim sCriteria() As String: sCriteria = Split(sCriteriaList, ",")
    
    ' Destination (Rows Count, Columns Count, Data Array)
    Dim drCount As Long
    drCount = Application.CountIf(srg.Columns(1), sCriteria(0))
    If drCount = 0 Then Exit Sub
    Dim dcCount As Long: dcCount = UBound(sCriteria) + 1
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To dcCount)
    
    ' Additional 'For Next Loop' Variables
    Dim sValue As Variant ' Source Value (First Column of the Source Array)
    Dim sIndex As Variant ' Index of the Source Value in Source Criteria Array
    Dim sr As Long ' Source Array Rows Counter
    Dim dr As Long ' Destination Array Rows Counter
    
    ' Write the values from the Source Array to the Destination Array.
    For sr = 1 To srCount
        sValue = sData(sr, shColumn)
        sIndex = Application.Match(sValue, sCriteria, 0)
        If IsNumeric(sIndex) Then ' Number i.e. 'sValue' found in 'sCriteria'
            If sIndex = 1 Then ' i.e. 'sValue = sCriteria(0)'
                dr = dr + 1
            'Else ' i.e. 'sValue <> sCriteria(0)'
            End If
            dData(dr, sIndex) = sData(sr, svColumn) ' write
        'Else ' Error Value i.e. 'sValue' not found in 'sCriteria'
        End If
    Next sr
    
    ' Write the values from the Destination Array to the Destination Range
    ' (Worksheet, First Cell, Range).
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dFirst)
    Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
    drg.Value = dData
    
    ' Clear the Clear Range, the range below the Destination Range, to remove
    ' possibly remaining data of a previously larger data set.
    Dim dcrg As Range: Set dcrg = _
        drg.Resize(dws.Rows.Count - drg.Row - drCount + 1).Offset(drCount)
    dcrg.Clear

    ' Inform.
    MsgBox "Vertical data transposed.", vbInformation, ProcTitle

End Sub

Answer 3

A simple way of doing this is using Power Query. Just paste the below code into a new query in the Power Query editor.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Unstack_Values_Column = List.Split(Source[Column2], 3),
    Convert_To_Table = Table.FromRows(Unstack_Values_Column,
            List.FirstN(Source[Column1], 3))
in
    Convert_To_Table

This assumes the following:

• The Data is in an excel table named "Table1"
• The column names are "Column1" & "Column2" respectively
• Both Columns follow the same repeating pattern every 3 rows.

The way this works:

    Unstack_Values_Column = List.Split(Source[Column2], 3),

This line selects Column2 as a list of values from the source table and then splits this list at every 3 values. It returns a new list where each value is a nested list of 3 values.

    Convert_To_Table = Table.FromRows(Unstack_Values_Column,
            List.FirstN(Source[Column1], 3))

This line converts the list of nested lists from the previous step to a table and also grabs the first three values from Column1 in the source table and uses them as the Column Names.

Where to paste the code above:

Open the query editor:

1. Select any cell in the table and then in the excel ribbon, select the data tab, and then click "From Table/Range" in the Get & Transform Data section. This will open a new window. This window is the query editor. Make sure a cell inside the table is selected when you click "From Table/Range"

Open the advanced editor window:

2. In the query editor window, select the view tab in the ribbon and then select the advanced editor button. This will open the advanced editor window.

Paste the code.

3. Remove all the text in the advanced editor window then paste the above code and click done to exit the advanced editor window. Back in the query editor window click file->close & load. This will close the advanced editor window and usually the "Import data" dialog box will open. Choose table and select where to load.