Bulk Transpose a formatted column help

[Chenko0160]

Hi All,

New to the site, but you all come highly recommended by a coworker. Hoping you can steer me in the right direction on this..

We have an old PBX phone system at work, where when the data is exported it's usually in a single column text document. I'd like to be able to take the data and make a proper table out of it.

Typically the data looks like this

DN 6853

CPND

NAME Test User1

XPLN 21

DISPLAY_FMT FIRST,LAST

TYPE SL1

TN 025 0 00 12 KEY 00 H MARP DES ADMIN 20 AUG 2018

-3903​

DN 6854

CPND

NAME Test User2

XPLN 21

DISPLAY_FMT FIRST,LAST

TYPE SL1

TN 026 0 00 06 KEY 00 H MARP DES NEW 16 JAN 2015

-3904​

In the end I'm trying to take that data and make a table I can easily sort by device type, extension, name.

DN 2806	CPND	NAME Test user1	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 022 0 00 08 KEY 01 H MARP DES NEW 22 JUL 2013	-3904​
DN 2807	CPND	NAME Test user2	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 042 0 00 01 KEY 01 H MARP DES NEW 19 SEP 2014	-3903​
DN 2808	CPND	NAME Test user3	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 021 0 00 06 KEY 01 H MARP DES TRAIL 7 JAN 2019	-3903​
DN 2810	CPND	NAME Test user4	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 041 0 00 07 KEY 01 H MARP DES SUECO 17 MAY 2017	-3903​
DN 2812	CPND	NAME Test user5	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 042 0 00 02 KEY 01 H MARP DES SUECO 8 NOV 2017	-3903​

So far I've been manually taking each chunk of 8 lines and pasting them transposed into another tab.. and this I guess works.. but is quite manual.

Would love any suggestions you can offer, and a big thank you in advance.
-Chenko

 

[smozgur]

Hi, Chenko
Welcome to the MrExcel Message Board!

Following is one of the ways to do what you need. I tried to put comments about "what's happening in this line" in the code.

Copy and paste the following VBA code in to a standard module, make sure the the active worksheet is the one you have the raw data, and execute the code.
It assumes there is a blank cell between each data set as given in your sample, and also assumes that data starts from the cell A1.

Sub transposeData()
Dim sht As Worksheet
Dim rng As Range
Dim trg As Range

    ' Data is in the active sheet
    Set sht = ActiveSheet
    
    ' Need two range objects
    ' rng for the raw data
    Set rng = sht.Range("A1")
    ' trg for the new data row to keep track
    ' of the next row reference to be created
    Set trg = sht.Range("A1")
    
    ' Execute the following
    ' until there is no data left in the raw data range
    Do While Not IsEmpty(rng.Value)
        ' Set the rng until the next empty row between data sets
        Set rng = sht.Range(rng.Cells(1, 1), rng.End(xlDown))
        ' Transfer rng values to the new data row
        trg.Resize(1, rng.Rows.Count).Value = Application.WorksheetFunction.Transpose(rng)
        ' Set the next raw data row for the next iteration
        Set rng = rng.Offset(rng.Rows.Count + 1).Resize(1)
        ' Set the next new data row for the next iteration
        Set trg = trg.Offset(1)
    Loop
    ' Remove everything left after the last "new data row"
    trg.Resize(sht.UsedRange.Count).ClearContents
End Sub

So, I have this raw data (repeated first data set to make it more rows):

1151266.xlsm
	A
1	DN 6853
2	CPND
3	NAME Test User1
4	XPLN 21
5	DISPLAY_FMT FIRST,LAST
6	TYPE SL1
7	TN 025 0 00 12 KEY 00 H MARP DES ADMIN 20 AUG 2018
8	-3903
9
10	DN 6854
11	CPND
12	NAME Test User2
13	XPLN 21
14	DISPLAY_FMT FIRST,LAST
15	TYPE SL1
16	TN 026 0 00 06 KEY 00 H MARP DES NEW 16 JAN 2015
17	-3904
18
19	DN 6853
20	CPND
21	NAME Test User1
22	XPLN 21
23	DISPLAY_FMT FIRST,LAST
24	TYPE SL1
25	TN 025 0 00 12 KEY 00 H MARP DES ADMIN 20 AUG 2018
26	-3903
Sheet1

And it is transformed to the following after the macro execution:

1151266.xlsm
	A	B	C	D	E	F	G	H
1	DN 6853	CPND	NAME Test User1	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 025 0 00 12 KEY 00 H MARP DES ADMIN 20 AUG 2018	-3903
2	DN 6854	CPND	NAME Test User2	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 026 0 00 06 KEY 00 H MARP DES NEW 16 JAN 2015	-3904
3	DN 6853	CPND	NAME Test User1	XPLN 21	DISPLAY_FMT FIRST,LAST	TYPE SL1	TN 025 0 00 12 KEY 00 H MARP DES ADMIN 20 AUG 2018	-3903
Sheet1

 

[Chenko0160]

Worked like a charm. Thank you so much for the quick response man!

 

[smozgur]

Worked like a charm. Thank you so much for the quick response man!

Glad to hear it helps.