Transpose variable data from a single column into multiple columns based on indent level

[Meta1]

Hello helpful excel folk!

I have been given a data export to cross reference that looks like it was created as some kind of pivot and the only data structures are the cell indents in the first column.

I have already used a small VBA script to populate the indent level of the cell data and now I am struggling to transpose that data based on each group of cells between indent level 0's while iterating through the other indent levels in the group. If there was a standard number of rows or indent levels it would probably be easy but this has variable numbers of locations and pages under each company.

Here is an example of the data i have with the indent level and what i am trying to have the resulting data look like:

Data	Time	IndentLevel
Company 1	9	0
Location 1 ​	9	1
Page 1 ​	2	2
Page 2​	1	2
Page 3​	6	2
Company 2	4	0
Location 1 ​	1	1
Page 1 ​	1	2
Location 2 ​	2	1
Page 1 ​	2	2
Location 3 ​	1	1
Page 1 ​	1	2

<tbody>
</tbody>

Company	Location	Page	Time
Company 1	Location 1	Page 1	2
Company 1	Location 1	Page 2	1
Company 1	Location 1	Page 3	6
Company 2	Location 1	Page 1	1
Company 2	Location 2	Page 1	2
Company 2	Location 3	Page 1	1

<tbody>
</tbody>

Any insight you can give me to solve this would be greatly appreciated.

-Meta1

 

[MickG]

This appears to work on your basic data ????
Results start "G1"

[COLOR="Navy"]Sub[/COLOR] MG26Jan36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dent1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Dent2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Dent3 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 4)
Ray(1, 1) = "Company": Ray(1, 2) = "Location": Ray(1, 3) = "Page": Ray(1, 4) = "Time"
c = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
Dn.Offset(, 3) = Dn.IndentLevel
[COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.IndentLevel
    [COLOR="Navy"]Case[/COLOR] 1: Dent1 = Dn.Value: Dent2 = "": Dent3 = ""
    [COLOR="Navy"]Case[/COLOR] 3: Dent2 = Dn.Value
    [COLOR="Navy"]Case[/COLOR] 6: Dent3 = Dn.Value
[COLOR="Navy"]End[/COLOR] Select
Txt = Dent1 & Dent2 & Dent3
[COLOR="Navy"]If[/COLOR] Dent1 <> "" And Dent2 <> "" And Dent3 <> "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Ray(c, 1) = Dent1
        Ray(c, 2) = Dent2
        Ray(c, 3) = Dent3
        Ray(c, 4) = Dn.Offset(, 1).Value
        .Add Txt, Nothing
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Range("G1").Resize(c, 4) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Akuini]

Another option:
Hope your data is not too big.

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1085172a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1085172-transpose-variable-data-single-column-into-multiple-columns-based-indent-level.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] rng [COLOR=Royalblue]As[/COLOR] Range
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
n = Range([COLOR=brown]"A"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] n
    j = n + i + [COLOR=crimson]2[/COLOR]
    [COLOR=Royalblue]Select[/COLOR] [COLOR=Royalblue]Case[/COLOR] Cells(i, [COLOR=crimson]3[/COLOR])
        [COLOR=Royalblue]Case[/COLOR] [COLOR=crimson]0[/COLOR]: Cells(j, [COLOR=brown]"E"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], [COLOR=crimson]3[/COLOR]).Value = Cells(i, [COLOR=brown]"A"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], [COLOR=crimson]3[/COLOR]).Value
        [COLOR=Royalblue]Case[/COLOR] [COLOR=crimson]1[/COLOR]: Cells(j, [COLOR=brown]"F"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], [COLOR=crimson]3[/COLOR]).Value = Cells(i, [COLOR=brown]"A"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], [COLOR=crimson]3[/COLOR]).Value
        [COLOR=Royalblue]Case[/COLOR] [COLOR=crimson]2[/COLOR]: Cells(j, [COLOR=brown]"G"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], [COLOR=crimson]3[/COLOR]).Value = Cells(i, [COLOR=brown]"A"[/COLOR]).Resize([COLOR=crimson]1[/COLOR], [COLOR=crimson]3[/COLOR]).Value
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Select[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

[COLOR=Royalblue]For[/COLOR] i = n + [COLOR=crimson]4[/COLOR] [COLOR=Royalblue]To[/COLOR] n + n + [COLOR=crimson]2[/COLOR]
    [COLOR=Royalblue]If[/COLOR] Cells(i, [COLOR=brown]"E"[/COLOR]) = [COLOR=brown]""[/COLOR] [COLOR=Royalblue]Then[/COLOR] Cells(i, [COLOR=brown]"E"[/COLOR]) = Cells(i - [COLOR=crimson]1[/COLOR], [COLOR=brown]"E"[/COLOR])
    [COLOR=Royalblue]If[/COLOR] Cells(i, [COLOR=brown]"F"[/COLOR]) = [COLOR=brown]""[/COLOR] [COLOR=Royalblue]Then[/COLOR] Cells(i, [COLOR=brown]"F"[/COLOR]) = Cells(i - [COLOR=crimson]1[/COLOR], [COLOR=brown]"F"[/COLOR])
[COLOR=Royalblue]Next[/COLOR]

Range([COLOR=brown]"I"[/COLOR] & n + [COLOR=crimson]4[/COLOR] & [COLOR=brown]":I"[/COLOR] & n + n + [COLOR=crimson]2[/COLOR]).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range([COLOR=brown]"E2:I"[/COLOR] & n + [COLOR=crimson]3[/COLOR]).Delete
Range([COLOR=brown]"E1:H1"[/COLOR]) = Application.Transpose(Application.Transpose(Split([COLOR=brown]"Company Location Page Time"[/COLOR])))
Columns([COLOR=brown]"I"[/COLOR]).Delete
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[Meta1]

MickG and Akuini thank you very much for sharing your expertise. Akuini, I did manage to get your code to run and it worked perfectly. My data set isn't that big so it didn't take too long. Mick, I am eager to test out your code as well even though I have a working solution just so I can learn more things about VBA code.. right now it all looks like wizardry. I got it to spit out the headers and I see the new column with indent data but the data didn't populate. I am no VBA expert and probably doing something fundamentally wrong with it. I put the code into a module and went to A1 on the sheet and back to VBA to run sub. Is that how the code is meant to be used?

Cheers,
Meta1

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.

 

[MickG]

This Example file may help.
https://app.box.com/s/b7snkdn8as2pk35133rqb1zpn13fdh76

 

[Meta1]

Mick, thank you for that example file. I see what I was doing wrong and got your code to work! Many thanks again to you and Akuini for sparing me some gray hairs, it would have taken me quite some time to figure out how to do that and now I have two different strategies to learn from.

Cheers,
Meta1

 

[MickG]

You're welcome

 

[=ODIN=]

Such a good question!

It looks like you were trying to unPivot a report created by a Compact Pivot Table.
I use the nutilities add-in to do this -- it handles a variable number of columns and header rows.

It can be downloaded here: http://www.iwishexcel.com/

Once installed, hit Ctrl+Alt+Shift+Enter within Excel to bring up the instructions and then checkout the UnPivot-Compact nutility on the Author's Favorites tab.

 

[Meta1]

Thanks ODIN for the suggestion. Looks like an interesting and useful add-in.