Transforming Single Column data to Range/Rows

agentx95

New Member
Joined
Apr 4, 2019
Messages
4
Hi, i am new here. I need help for this, so I have a long list of data and I need to convert/transform in into comprehensible range or rows. Excel will start a new row after each blank in the column.

like this:

data:

Ref#XXX
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
-blank-
Ref#XXX
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
-blank-
Ref#XXX
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt


to this output,

Ref#XXX Acct#XXX Desc Amt Acct#XXX Desc Amt
Ref#XXX Acct#XXX Desc Amt Acct#XXX Desc Amt Acct#XXX Desc Amt
Ref#XXX Acct#XXX Desc Amt Acct#XXX Desc Amt

Thanks for any help.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Hi agentx95,

Welcome to MrExcel!!

Try this macro while on the sheet in question:

Code:
Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim lngPasteCol As Long
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
    
    lngPasteRow = 2 'Initial output Row. Change to suit.
    
    For lngMyRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row 'Works from Row 2 down to the last Row in Col. A. Change to suit.
        If Len(Range("A" & lngMyRow)) > 0 Then
            lngPasteCol = Cells(lngPasteRow, Columns.Count).End(xlToLeft).Column + 1
            Cells(lngPasteRow, lngPasteCol).Value = Range("A" & lngMyRow).Value
        Else
            lngPasteRow = lngPasteRow + 1
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Upvote 0
source
Ref#XXX
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
Ref#XXX
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
Ref#XXX
Acct#XXX
Desc
Amnt
Acct#XXX
Desc
Amnt
Ref#XXX
Acct#XXX
Desc
Amnt

you can try PowerQuery (Get&Transform)

result.1result.2result.3result.4result.5result.6result.7result.8result.9result.10
Ref#XXXAcct#XXXDescAmntAcct#XXXDescAmnt
Ref#XXXAcct#XXXDescAmntAcct#XXXDescAmntAcct#XXXDescAmnt
Ref#XXXAcct#XXXDescAmntAcct#XXXDescAmnt
Ref#XXXAcct#XXXDescAmnt

Code:
[SIZE=1]let
    Source = Excel.CurrentWorkbook(){[Name="Table16"]}[Content],
    Trans = Table.Transpose(Source),
    MergeCols = Table.CombineColumns(Table.TransformColumnTypes(Trans, {{"Column8", type text}, {"Column19", type text}, {"Column27", type text}}, "en-GB"),{"Column1", "Column2", "Column3", "Column4", "Column5", "Column6", "Column7", "Column8", "Column9", "Column10", "Column11", "Column12", "Column13", "Column14", "Column15", "Column16", "Column17", "Column18", "Column19", "Column20", "Column21", "Column22", "Column23", "Column24", "Column25", "Column26", "Column27", "Column28", "Column29", "Column30", "Column31"},Combiner.CombineTextByDelimiter(",", QuoteStyle.None),"result"),
    SplitToRows = Table.ExpandListColumn(Table.TransformColumns(MergeCols, {{"result", Splitter.SplitTextByDelimiter(",,", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "result"),
    SplitToCols = Table.SplitColumn(SplitToRows, "result", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"result.1", "result.2", "result.3", "result.4", "result.5", "result.6", "result.7", "result.8", "result.9", "result.10"})
in
    SplitToCols[/SIZE]
 
Last edited:
Upvote 0
Does this macro do what you want...
Code:
Sub RearrangeData()
  Dim Ar As Range
  For Each Ar In Columns("A").SpecialCells(xlConstants).Areas
    Ar(1).Resize(, Ar.Count) = Application.Transpose(Ar)
  Next
  Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
End Sub
 
Upvote 0
It worked. Thank you so much...



Hi agentx95,

Welcome to MrExcel!!

Try this macro while on the sheet in question:

Code:
Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim lngPasteCol As Long
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
    
    lngPasteRow = 2 'Initial output Row. Change to suit.
    
    For lngMyRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row 'Works from Row 2 down to the last Row in Col. A. Change to suit.
        If Len(Range("A" & lngMyRow)) > 0 Then
            lngPasteCol = Cells(lngPasteRow, Columns.Count).End(xlToLeft).Column + 1
            Cells(lngPasteRow, lngPasteCol).Value = Range("A" & lngMyRow).Value
        Else
            lngPasteRow = lngPasteRow + 1
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Upvote 0
This worked for me too! Thank you very much. Been at this for weeks.


Does this macro do what you want...
Code:
Sub RearrangeData()
  Dim Ar As Range
  For Each Ar In Columns("A").SpecialCells(xlConstants).Areas
    Ar(1).Resize(, Ar.Count) = Application.Transpose(Ar)
  Next
  Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
End Sub
 
Upvote 0

Forum statistics

Threads
1,212,938
Messages
6,110,782
Members
448,297
Latest member
carmadgar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top