Modification of macro - re-arrangment of information in data set.

A

Akakaboto

Board Regular
Joined
Jun 27, 2012
Messages
51
Good day,

I would like some help to modify a macro in order for me to get the data set as I want it.

the data set currently looks like
ABCDEFGH
1ItemPurchasing Doc. TypePurch. Doc. CategoryPurchasing GroupPO history/release documentationDocument DateVendor/supplying plantMaterialShort TextValidity Per. StartValidity Period EndMaterial GroupDeletion IndicatorItem CategoryAcct Assignment Cat.PlantStorage LocationOrder QuantityOrder UnitQuantity in SKUStockkeeping unitNet priceCurrencyPrice UnitTarget Val. (Header)Target QuantityOpen Target QuantityNo. of Positions
2 19542
3Purchasing Document 200610026 3
410YF4WKA09 2012-12-20A4000012991XX2013-01-012013-12-3196201000 VP145 0,000EA0,000KG3300,00USD10,000,0000,0001
520YF4WKA09 2012-12-20A4000012992XY2013-01-012013-12-3196201000 VP145 0,000EA0,000KG3200,00USD10,000,0000,0001
630YF4WKA09 2012-12-20A4000012993XZ2013-01-012013-12-3196201000 VP145 0,000EA0,000KG3200,00USD10,000,0000,0001
7Purchasing Document 200610045 2
810YF4WKA03 2012-10-31100072 DHL Freight (Sweden) AB4000000553SE Dalsland - SE Arvika2011-11-212013-12-3196406000 VP145 0,000KG0,000KG53,30SEK1000,000,0000,0001
920YF4WKA03@0N\QPO history/release documentati@2012-10-31100072 DHL Freight (Sweden) AB4000000554SE Värmland - SE Arvika2011-11-212013-12-3196406000 VP145 0,000KG0,000KG58,00SEK1000,000,0000,0001
10Purchasing Document 200610107 3
1110YF4WKA16@0N\QPO history/release documentati@2012-12-20109852 Hoyer Svenska AB4000008287SE Helsingborg-SE Göteborg,Spolarvätska2013-01-012013-12-3196403000 VP145 0,000EA0,000KG15391,00SEK10,000,0000,0001
1220YF4WKA16 2012-12-20109852 Hoyer Svenska AB4090000111Loading/discharge 3hrs incl, cost/hour2013-01-012013-12-3196403000 VP145 0,000EA0,000EA535,00SEK10,000,0000,0001
1330YF4WKA16 2012-12-20109852 Hoyer Svenska AB4690000024Cont.rent incl arrival+1day, cost/day2013-01-012013-12-3196403000 VP145 0,000EA0,000EA350,00SEK10,000,0000,0001

<COLGROUP><COL style="WIDTH: 16pt; mso-width-source: userset; mso-width-alt: 768" width=21><COL style="WIDTH: 165pt; mso-width-source: userset; mso-width-alt: 8045" width=220><COL style="WIDTH: 48pt" span=4 width=64><COL style="WIDTH: 74pt; mso-width-source: userset; mso-width-alt: 3584" width=98><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 58pt; mso-width-source: userset; mso-width-alt: 2816" width=77><COL style="WIDTH: 257pt; mso-width-source: userset; mso-width-alt: 12507" width=342><COL style="WIDTH: 83pt; mso-width-source: userset; mso-width-alt: 4059" width=111><COL style="WIDTH: 89pt; mso-width-source: userset; mso-width-alt: 4352" width=119><COL style="WIDTH: 48pt" span=17 width=64><TBODY>
</TBODY>


I would like to have it in the following format
ABCDEFG.......
1Purchase orderItemPurchasing Doc. TypePurch. Doc. CategoryPurchasing GroupPO history/release documentationetc.
220061002610YF4WKA09
320061002620YF4WKA09
420061002630YF4WKA09
520061004510YF4WKA03
620061004520YF4WKA03@0N\QPO history/release documentati@
720061010710YF4WKA16@0N\QPO history/release documentati@
820061010720YF4WKA16
920061010730YF4WKA16
10.........

<COLGROUP><COL style="WIDTH: 16pt; mso-width-source: userset; mso-width-alt: 768" width=21><COL style="WIDTH: 76pt; mso-width-source: userset; mso-width-alt: 3693" width=101><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 77pt; mso-width-source: userset; mso-width-alt: 3766" width=103><COL style="WIDTH: 98pt; mso-width-source: userset; mso-width-alt: 4754" width=130><COL style="WIDTH: 65pt; mso-width-source: userset; mso-width-alt: 3181" width=87><COL style="WIDTH: 189pt; mso-width-source: userset; mso-width-alt: 9216" width=252><COL style="WIDTH: 48pt" width=64><TBODY>
</TBODY>


The macro that I used before is presented below but is not working with the current structure of the report. I would be very thankful if someone could modify it to work properly.

Sub Me3n()
Dim Rng As Range
Dim Dn As Range
Dim Ac As Integer
Dim Num As String
Dim c As Long
Set Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 29)
For Each Dn In Rng
If Not IsEmpty(Dn.Value) Then
If Split(Dn, " ")(0) = "Purchasing" Then
Num = Split(Dn, " ")(2)
Else
c = c + 1
For Ac = 1 To 28
If Num = "" Then
ray(c, 1) = "Purchasing Document"
ray(c, Ac + 1) = Dn(, Ac)
Else
ray(c, 1) = Num
ray(c, Ac + 1) = Dn(, Ac)
End If
Next Ac
End If
End If
Next Dn
Sheets("Sheet2").Range("A1").Resize(c, 29) = ray
End Sub

Best regards,
Akakaboto
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Try this:-
Run from data sheet
Results sheet2,Start "A1".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG14May40
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Temp    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 29)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn Like "Purchasing Document *" [COLOR="Navy"]Then[/COLOR]
        Temp = Dn
    [COLOR="Navy"]Else[/COLOR]
        c = c + 1
        [COLOR="Navy"]For[/COLOR] n = 1 To 29
            [COLOR="Navy"]If[/COLOR] n = 1 [COLOR="Navy"]Then[/COLOR]
                Ray(c, n) = Temp
            [COLOR="Navy"]Else[/COLOR]
                Ray(c, n) = Dn(, n - 1)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    .Range("a1") = "Purchase Order"
    [COLOR="Navy"]With[/COLOR] .Range("B1:AC1")
        .Value = Range("A1:AB1").Value
        .WrapText = True
     [COLOR="Navy"]End[/COLOR] With
    .Range("A2").Resize(c, 29) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hello Mick,

I't did not come out right.

To clarify:
- Cell A1 is "item"
- the data set consists of 20000+ rows

Outcome of the macro:
Purchase Order ABCDEFGH
2
3Purchasing Document 200610026
410YF4WKA09 2012-12-20A4000012991XX2013-01-012013-12-3196201000 VP145 0EA0KG3300USD1000
520YF4WKA09 2012-12-20A4000012992XY2013-01-012013-12-3196201000 VP145 0EA0KG3200USD1000
630YF4WKA09 2012-12-20A4000012993XZ2013-01-012013-12-3196201000 VP145 0EA0KG3200USD1000
7Purchasing Document 200610045
810YF4WKA03 2012-10-31100072 DHL Freight (Sweden) AB4000000553SE Dalsland - SE Arvika2011-11-212013-12-3196406000 VP145 0KG0KG53,3SEK100000
920YF4WKA03@0N\QPO history/release documentati@2012-10-31100072 DHL Freight (Sweden) AB4000000554SE Värmland - SE Arvika2011-11-212013-12-3196406000 VP145 0KG0KG58SEK100000
10Purchasing Document 200610107
1110YF4WKA16@0N\QPO history/release documentati@2012-12-20109852 Hoyer Svenska AB4000008287SE Helsingborg-SE Göteborg,Spolarvätska2013-01-012013-12-3196403000 VP145 0EA0KG15391SEK1000
1220YF4WKA16 2012-12-20109852 Hoyer Svenska AB4090000111Loading/discharge 3hrs incl, cost/hour2013-01-012013-12-3196403000 VP145 0EA0EA535SEK1000
1330YF4WKA16 2012-12-20109852 Hoyer Svenska AB4690000024Cont.rent incl arrival+1day, cost/day2013-01-012013-12-3196403000 VP145 0EA0EA350SEK1000

<COLGROUP><COL style="WIDTH: 77pt; mso-width-source: userset; mso-width-alt: 3766" width=103><COL style="WIDTH: 16pt; mso-width-source: userset; mso-width-alt: 768" width=21><COL style="WIDTH: 155pt; mso-width-source: userset; mso-width-alt: 7533" width=206><COL style="WIDTH: 33pt; mso-width-source: userset; mso-width-alt: 1609" width=44><COL style="WIDTH: 12pt; mso-width-source: userset; mso-width-alt: 585" width=16><COL style="WIDTH: 23pt; mso-width-source: userset; mso-width-alt: 1097" width=30><COL style="WIDTH: 203pt; mso-width-source: userset; mso-width-alt: 9910" width=271><COL style="WIDTH: 55pt; mso-width-source: userset; mso-width-alt: 2669" width=73><COL style="WIDTH: 167pt; mso-width-source: userset; mso-width-alt: 8155" width=223><COL style="WIDTH: 58pt; mso-width-source: userset; mso-width-alt: 2816" width=77><COL style="WIDTH: 200pt; mso-width-source: userset; mso-width-alt: 9764" width=267><COL style="WIDTH: 55pt; mso-width-source: userset; mso-width-alt: 2669" span=2 width=73><COL style="WIDTH: 47pt; mso-width-source: userset; mso-width-alt: 2304" width=63><COL style="WIDTH: 48pt" span=2 width=64><COL style="WIDTH: 12pt; mso-width-source: userset; mso-width-alt: 585" width=16><COL style="WIDTH: 27pt; mso-width-source: userset; mso-width-alt: 1316" width=36><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 11pt; mso-width-source: userset; mso-width-alt: 512" width=14><COL style="WIDTH: 18pt; mso-width-source: userset; mso-width-alt: 877" width=24><COL style="WIDTH: 11pt; mso-width-source: userset; mso-width-alt: 512" width=14><COL style="WIDTH: 18pt; mso-width-source: userset; mso-width-alt: 877" width=24><COL style="WIDTH: 32pt; mso-width-source: userset; mso-width-alt: 1536" width=42><COL style="WIDTH: 24pt; mso-width-source: userset; mso-width-alt: 1170" width=32><COL style="WIDTH: 21pt; mso-width-source: userset; mso-width-alt: 1024" width=28><COL style="WIDTH: 11pt; mso-width-source: userset; mso-width-alt: 512" span=3 width=14><TBODY>
</TBODY>

best regards,
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
Macros - Auto Copy paste row when cell value changes
Replies
7
Views
5K
Fluff
Fluff
N
  • Question
excel macro to split data into multiple worksheets based on conditions worksheet
Replies
4
Views
4K
Fluff
Fluff
L
  • Question
VBA - Consolidate data and Sum mulitiple ranges
Replies
1
Views
1K
MickG
M
T
  • Question
Macro needed to add items to worksheet
Replies
3
Views
982
onlyadrafter
O
G
  • Question
Transpose matching data from columns to rows
Replies
3
Views
730
bwaaack
B

Forum statistics

Threads
1,215,430
Messages
6,124,847
Members
449,194
Latest member
HellScout

Share this page

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