Macro to rearrange structure of report.

Carl_H · Sep 16, 2014

Hello,

Is it possible to change the structure of this report:

To look like this:

[/IMG]

if anyone can help me I would be very grateful.

My report has a lot more rows than above but the columns are the same.

Carl_H · Sep 16, 2014

Hello,

I was thinking maybe it will be easier if a make a table that you can copy paste into an excelsheet. If you need further information I'll do my best to provide it for you.

Also there is 2 blanks between * and the cost center name, and 3 blanks before the cost element if that is important facts.
[TABLE="width: 679"]
<TBODY>[TR]
[TD]Act. per 8
[/TD]
[TD]Plan. per 8
[/TD]
[TD]Var. per 8
[/TD]
[TD]Cost centers/Cost elements
[/TD]
[TD]Act per 01 - 8
[/TD]
[TD]Plan version 3
[/TD]
[/TR]
[TR]
[TD="align: right"]1769
[/TD]
[TD="align: right"]41666,66
[/TD]
[TD="align: right"]-39897,66
[/TD]
[TD]591202 Customer magazines, production
[/TD]
[TD="align: right"]453677
[/TD]
[TD="align: right"]500000
[/TD]
[/TR]
[TR]
[TD="align: right"]-140
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]-140
[/TD]
[TD]591816 Customer magazines
[/TD]
[TD="align: right"]-2520
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]625001 Postal expenses
[/TD]
[TD="align: right"]-1499990,5
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]655901 Other consultant fees
[/TD]
[TD="align: right"]217271
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]148
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]148
[/TD]
[TD]659202 Hired Services Elanders (Publ Store)
[/TD]
[TD="align: right"]752
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]1777
[/TD]
[TD="align: right"]41666,66
[/TD]
[TD="align: right"]-39889,66
[/TD]
[TD]* 19065 Customer magazines
[/TD]
[TD="align: right"]-830810,5
[/TD]
[TD="align: right"]500000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]564901 Demo/test vehicle miscellaneous
[/TD]
[TD="align: right"]107138
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]* 19066 VT Press Test
[/TD]
[TD="align: right"]107138
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]4166,66
[/TD]
[TD="align: right"]-4166,66
[/TD]
[TD]591101 Daily press media space
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]50000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]41666,66
[/TD]
[TD="align: right"]-41666,66
[/TD]
[TD]591201 Magazine media space
[/TD]
[TD="align: right"]329504,25
[/TD]
[TD="align: right"]500000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]591802 Advertising
[/TD]
[TD="align: right"]10000
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]595002 POS production
[/TD]
[TD="align: right"]13158
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]597102 Photos production
[/TD]
[TD="align: right"]1500
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]4583,34
[/TD]
[TD="align: right"]-4583,34
[/TD]
[TD]597401 Internet
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]55000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]8333,34
[/TD]
[TD="align: right"]-8333,34
[/TD]
[TD]599701 Other advertising costs
[/TD]
[TD="align: right"]136700
[/TD]
[TD="align: right"]100000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]8333,34
[/TD]
[TD="align: right"]-8333,34
[/TD]
[TD]615001 Printed matter
[/TD]
[TD="align: right"]11406
[/TD]
[TD="align: right"]100000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]67083,34
[/TD]
[TD="align: right"]-67083,34
[/TD]
[TD]* 19067 VT Advertising
[/TD]
[TD="align: right"]502268,25
[/TD]
[TD="align: right"]805000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]2083,34
[/TD]
[TD="align: right"]-2083,34
[/TD]
[TD]564901 Demo/test vehicle miscellaneous
[/TD]
[TD="align: right"]25120
[/TD]
[TD="align: right"]25000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]581003 Tickets other countries
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]14290
[/TD]
[TD="align: right"]1250
[/TD]
[TD="align: right"]13040
[/TD]
[TD]597102 Photos production
[/TD]
[TD="align: right"]14290
[/TD]
[TD="align: right"]15000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]28750
[/TD]
[TD="align: right"]-28750
[/TD]
[TD]598401 Sponsorship
[/TD]
[TD="align: right"]326058,2
[/TD]
[TD="align: right"]345000
[/TD]
[/TR]
[TR]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]0
[/TD]
[TD]609801 Other sales costs
[/TD]
[TD="align: right"]173,41
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]25119,13
[/TD]
[TD="align: right"]0
[/TD]
[TD="align: right"]25119,13
[/TD]
[TD]783501 Depreciation of cars
[/TD]
[TD="align: right"]25119,13
[/TD]
[TD="align: right"]0
[/TD]
[/TR]
[TR]
[TD="align: right"]39409,13
[/TD]
[TD="align: right"]32083,34
[/TD]
[TD="align: right"]7325,79
[/TD]
[TD]* 19069 VT PR/Media
[/TD]
[TD="align: right"]390760,74
[/TD]
[TD="align: right"]385000
[/TD]
[/TR]
</TBODY>[/TABLE]

Andrew Poulsom · Sep 16, 2014

Do the headings actually repeat like in your first example?

Carl_H · Sep 16, 2014

Andrew Poulsom said:
Do the headings actually repeat like in your first example?

Yes they do. I only want the heading displayed once. However, if that is a big issue I can delete the duplicate headings before running the macro.

Andrew Poulsom · Sep 16, 2014

With the additional headings removed try:

Code:

Sub Test()
    Dim ShNew As Worksheet
    Dim LastRow As Long
    Dim First As Long
    Dim r As Long
    Dim i As Long
    Set ShNew = Worksheets.Add
    ShNew.Range("A1:I1").Value = Array("Act. per 8", "Plan. per 8", "Var. per 8", "Cost center", "Cost center text", "Cost element", "Cost element text", "Act per 01 - 8", "Plan version 3")
    First = 2
    r = 2
    With Worksheets("Sheet1")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To LastRow
            If Left(.Range("D" & i).Value, 1) <> "*" Then
                .Range("A" & i).Resize(, 3).Copy ShNew.Range("A" & r)
                ShNew.Range("F" & r).Value = Left(.Range("D" & i).Value, 6)
                ShNew.Range("G" & r).Value = Mid(.Range("D" & i).Value, 8)
                .Range("E" & i).Resize(, 2).Copy ShNew.Range("H" & r)
                r = r + 1
            Else
                ShNew.Range("D" & First & ":D" & r - 1).Value = Mid(Trim(.Range("D" & i).Value), 3, 5)
                ShNew.Range("E" & First & ":E" & r - 1).Value = Mid(Trim(.Range("D" & i).Value), 9)
                First = r
            End If
        Next i
    End With
End Sub

Carl_H · Sep 16, 2014

Hello,

First of all, thanks for your effort so far. It almost worked.

The result when I ran the macro can be found below: As you can see, last digit of cost center is missing, and if you paste the data below into an excel sheet you will also see that the cost element number only displays 3 digits in the correct column.

If you reply, I will not have time to check new result until tomorrow as I am about to leave work.

And by the way: I just started my new job and when I can start to use this macro I will be able to rebuild our report which will easily save me 30-40 hours a month, not having to do any copy paste which my former colleague seemed to like

So once again. Thanks a lot!

EDIT: I did not include cost center 19066 below.
[TABLE="width: 901"]
<TBODY>[TR]
[TD]Act. per 8
[/TD]
[TD]Plan. per 8
[/TD]
[TD]Var. per 8
[/TD]
[TD]Cost center
[/TD]
[TD]Cost center text
[/TD]
[TD]Cost element
[/TD]
[TD]Cost element text
[/TD]
[TD]Act per 01 - 8
[/TD]
[TD]Plan version 3
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]4 166,66
[/TD]
[TD]4 166,66-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]591
[/TD]
[TD]01 Daily press media space
[/TD]
[TD][/TD]
[TD="align: right"]50 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]41 666,66
[/TD]
[TD]41 666,66-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]591
[/TD]
[TD]01 Magazine media space
[/TD]
[TD="align: right"]329 504,25
[/TD]
[TD="align: right"]500 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]591
[/TD]
[TD]02 Advertising
[/TD]
[TD="align: right"]10 000,00
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]595
[/TD]
[TD]02 POS production
[/TD]
[TD="align: right"]13 158,00
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]597
[/TD]
[TD]02 Photos production
[/TD]
[TD="align: right"]1 500,00
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]4 583,34
[/TD]
[TD]4 583,34-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]597
[/TD]
[TD]01 Internet
[/TD]
[TD][/TD]
[TD="align: right"]55 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]8 333,34
[/TD]
[TD]8 333,34-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]599
[/TD]
[TD]01 Other advertising costs
[/TD]
[TD="align: right"]136 700,00
[/TD]
[TD="align: right"]100 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]8 333,34
[/TD]
[TD]8 333,34-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT Advertising
[/TD]
[TD="align: right"]615
[/TD]
[TD]01 Printed matter
[/TD]
[TD="align: right"]11 406,00
[/TD]
[TD="align: right"]100 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]2 083,34
[/TD]
[TD]2 083,34-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT PR/Media
[/TD]
[TD="align: right"]564
[/TD]
[TD]01 Demo/test vehicle miscellaneous
[/TD]
[TD="align: right"]25 120,00
[/TD]
[TD="align: right"]25 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]1906
[/TD]
[TD]VT PR/Media
[/TD]
[TD="align: right"]581
[/TD]
[TD]03 Tickets other countries
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]14 290,00
[/TD]
[TD="align: right"]1 250,00
[/TD]
[TD="align: right"]13 040,00
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT PR/Media
[/TD]
[TD="align: right"]597
[/TD]
[TD]02 Photos production
[/TD]
[TD="align: right"]14 290,00
[/TD]
[TD="align: right"]15 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]28 750,00
[/TD]
[TD]28 750,00-
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT PR/Media
[/TD]
[TD="align: right"]598
[/TD]
[TD]01 Sponsorship
[/TD]
[TD="align: right"]326 058,20
[/TD]
[TD="align: right"]345 000,00
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]1906
[/TD]
[TD]VT PR/Media
[/TD]
[TD="align: right"]609
[/TD]
[TD]01 Other sales costs
[/TD]
[TD="align: right"]173,41
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]25 119,13
[/TD]
[TD][/TD]
[TD="align: right"]25 119,13
[/TD]
[TD="align: right"]1906
[/TD]
[TD]VT PR/Media
[/TD]
[TD="align: right"]783
[/TD]
[TD]01 Depreciation of cars
[/TD]
[TD="align: right"]25 119,13
[/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]

Andrew Poulsom · Sep 16, 2014

This is what I got with your sample data:

Excel 2010

A

B

C

D

E

F

G

H

I

1

Act. per 8

Plan. per 8

Var. per 8

Cost center

Cost center text

Cost element

Cost element text

Act per 01 - 8

Plan version 3

2

1769

41666.66

-39897.66

19065

Customer magazines

591202

Customer magazines. production

453677

500000

3

-140

0

-140

19065

Customer magazines

591816

Customer magazines

-2520

0

4

0

19065

Customer magazines

625001

Postal expenses

-1499990.5

0

5

0

19065

Customer magazines

655901

Other consultant fees

217271

0

6

148

0

148

19065

Customer magazines

659202

Hired Services Elanders (Publ Store)

752

0

7

0

19066

VT Press Test

564901

Demo/test vehicle miscellaneous

107138

0

8

0

4166.66

-4166.66

19067

VT Advertising

591101

Daily press media space

0

50000

9

0

41666.66

-41666.66

19067

VT Advertising

591201

Magazine media space

329504.25

500000

10

0

19067

VT Advertising

591802

Advertising

10000

0

11

0

19067

VT Advertising

595002

POS production

13158

0

12

0

19067

VT Advertising

597102

Photos production

1500

0

13

0

4583.34

-4583.34

19067

VT Advertising

597401

Internet

0

55000

14

0

8333.34

-8333.34

19067

VT Advertising

599701

Other advertising costs

136700

100000

15

0

8333.34

-8333.34

19067

VT Advertising

615001

Printed matter

11406

100000

16

0

2083.34

-2083.34

19069

VT PR/Media

564901

Demo/test vehicle miscellaneous

25120

25000

17

0

19069

VT PR/Media

581003

Tickets other countries

0

18

14290

1250

13040

19069

VT PR/Media

597102

Photos production

14290

15000

19

0

28750

-28750

19069

VT PR/Media

598401

Sponsorship

326058.2

345000

20

0

19069

VT PR/Media

609801

Other sales costs

173.41

0

21

25119.13

0

25119.13

19069

VT PR/Media

783501

Depreciation of cars

25119.13

0

Sheet4

Carl_H · Sep 16, 2014

Hello,

with the data I pasted at first it works beautifully. However, it seems extra "blanks" have been removed when I pasted the data. My data set looks like * "blank" "blank" 19065 Customer magazines (* 19065 Customer magazines) and for the cost elements there is e.g. "blank" "blank" "blank" 591202 Customer magazines, production ( 591202 Customer magazines, production).

Andrew Poulsom · Sep 16, 2014

How about?

Code:

Sub Test()
    Dim ShNew As Worksheet
    Dim LastRow As Long
    Dim First As Long
    Dim r As Long
    Dim i As Long
    Set ShNew = Worksheets.Add
    ShNew.Range("A1:I1").Value = Array("Act. per 8", "Plan. per 8", "Var. per 8", "Cost center", "Cost center text", "Cost element", "Cost element text", "Act per 01 - 8", "Plan version 3")
    First = 2
    r = 2
    With Worksheets("Sheet1")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To LastRow
            If Left(.Range("D" & i).Value, 1) <> "*" Then
                .Range("A" & i).Resize(, 3).Copy ShNew.Range("A" & r)
                ShNew.Range("F" & r).Value = Left(WorksheetFunction.Trim(.Range("D" & i).Value), 6)
                ShNew.Range("G" & r).Value = Mid(WorksheetFunction.Trim(.Range("D" & i).Value), 8)
                .Range("E" & i).Resize(, 2).Copy ShNew.Range("H" & r)
                r = r + 1
            Else
                ShNew.Range("D" & First & ":D" & r - 1).Value = Mid(WorksheetFunction.Trim(.Range("D" & i).Value), 3, 5)
                ShNew.Range("E" & First & ":E" & r - 1).Value = Mid(WorksheetFunction.Trim(.Range("D" & i).Value), 9)
                First = r
            End If
        Next i
    End With
End Sub

Carl_H · Sep 17, 2014

Now it works perfectly. Thank you so much for your help and time spent on this!!!!

Macro to rearrange structure of report.

Carl_H

New Member

Excel Facts

Carl_H

New Member

Andrew Poulsom

MrExcel MVP

Carl_H

New Member

Andrew Poulsom

MrExcel MVP

Carl_H

New Member

Andrew Poulsom

MrExcel MVP

Carl_H

New Member

Andrew Poulsom

MrExcel MVP

Carl_H

New Member

Similar threads

Forum statistics

Share this page

Macro to rearrange structure of report.

New Member

Excel Facts

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock