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
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
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
 
Upvote 0
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
 
Upvote 0
The data should be as I showed in post #2 , if not, the macro does not work.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,148
Members
448,552
Latest member
WORKINGWITHNOLEADER

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