macro to move list headers to columns

Jos1972

New Member
Joined
Nov 3, 2008
Messages
33
Hello,
If I download a list from exact it looks like below:

Subtotaal
Akro Netherlands Inc. - 1682
19.026322-08-20191960388060 - Inkoopboek85 Plaatje zwart MDF
19.028211-09-20191960427960 - InkoopboekOpgebouwde wand + blisterhaken display
19.030527-09-20191960457760 - InkoopboekMateriaal Hema
Subtotaal
AMG Bouw BV - 1815
2019/0031127-09-20191960457860 - InkoopboekPelicaen Vitrine

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

Ideally I would like to move the account names to the column next to the numbers, until the next subtotal, so that I can build a proper pivot table with the option to filter on account.

I'm sure it can be done, but I lack the VBA experience. Would be great if anyone out there could help me.
Thank you,
Jos
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,679
Office Version
2007
Platform
Windows
Hi @Jos1972,
If you have something like this
<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:214.81px;" /><col style="width:71.29px;" /><col style="width:59.88px;" /><col style="width:130.22px;" /><col style="width:290.85px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >Subtotal</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >Akro Netherlands Inc. - 1682</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">19.0263</td><td style="text-align:right; ">22/08/2019</td><td style="text-align:right; ">19603880</td><td >60 - Inkoopboek</td><td >85 Plaatje zwart MDF</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="text-align:right; ">19.0282</td><td style="text-align:right; ">11/09/2019</td><td style="text-align:right; ">19604279</td><td >60 - Inkoopboek</td><td >Opgebouwde wand + blisterhaken display</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="text-align:right; ">19.0305</td><td style="text-align:right; ">27/09/2019</td><td style="text-align:right; ">19604577</td><td >60 - Inkoopboek</td><td >Materiaal Hema</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td >Subtotal</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td >AMG Bouw BV - 1815</td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td >2019/00311</td><td style="text-align:right; ">27/09/2019</td><td style="text-align:right; ">19604578</td><td >60 - Inkoopboek</td><td >Pelicaen Vitrine</td></tr></table>



And you need something like this:
<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:100.75px;" /><col style="width:214.81px;" /><col style="width:71.29px;" /><col style="width:59.88px;" /><col style="width:130.22px;" /><col style="width:380.2px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="text-align:right; ">19.0263</td><td >Akro Netherlands Inc. - 1682</td><td style="text-align:right; ">22/08/2019</td><td style="text-align:right; ">19603880</td><td >60 - Inkoopboek</td><td >85 Plaatje zwart MDF</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="text-align:right; ">19.0282</td><td >Akro Netherlands Inc. - 1682</td><td style="text-align:right; ">11/09/2019</td><td style="text-align:right; ">19604279</td><td >60 - Inkoopboek</td><td >Opgebouwde wand + blisterhaken display</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">19.0305</td><td >Akro Netherlands Inc. - 1682</td><td style="text-align:right; ">27/09/2019</td><td style="text-align:right; ">19604577</td><td >60 - Inkoopboek</td><td >Materiaal Hema</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >2019/00311</td><td >AMG Bouw BV - 1815</td><td style="text-align:right; ">27/09/2019</td><td style="text-align:right; ">19604578</td><td >60 - Inkoopboek</td><td >Pelicaen Vitrine</td></tr></table>


Then try this:
Code:
Sub move_headers_to_columns()
  Dim lr As Long, i As Long, a() As Variant, r As Range, aName As String
  Application.ScreenUpdating = False
  Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  lr = Range("A" & Rows.Count).End(xlUp).Row
  Set r = Range("A" & lr + 1)
  a = Range("A1:A" & lr)
  ReDim b(UBound(a) - 1)
  For i = 1 To UBound(a)
    b(i - 1) = aName
    If LCase(a(i, 1)) = LCase("Subtotal") Then
      Set r = Union(r, Range("A" & i), Range("A" & i + 1))
      aName = a(i + 1, 1)
    End If
  Next i
  Range("B1").Resize(UBound(a)).Value = Application.Transpose(b())
  r.EntireRow.Delete
End Sub
 

Jos1972

New Member
Joined
Nov 3, 2008
Messages
33
Hi Dante,
Thank you for your support. Unfortunately the macro is not working yet. It inserts the column B, but then nothing happens. Do I need to select a range before I can run the macro?
thank you,
Jos
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,679
Office Version
2007
Platform
Windows
The data should be as I showed in post #2 , if not, the macro does not work.
 

Jos1972

New Member
Joined
Nov 3, 2008
Messages
33
The data should be as I showed in post #2 , if not, the macro does not work.
hi Dante,
When I download your table to excel the macro works. but it still doesn't work with the original file.
Not sure what i can still do, but thank you you for your support anyways..
best regards,
jos
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,679
Office Version
2007
Platform
Windows
You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 

Jos1972

New Member
Joined
Nov 3, 2008
Messages
33
You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
Hi Dante,
I found the issue. I changed the word Subtotal to Subtotaal (2 a's, dutch spelling) and now it works smoothly.
Thanks!
Jos
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,679
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,085,466
Messages
5,383,858
Members
401,858
Latest member
Nitsalet

Some videos you may like

This Week's Hot Topics

Top