Maco Help - Copy linear monthly data in one row to multiple monthly rows

[1031exchanged]

Hello all,

Hoping someone can help or tell me this isn't possible. I'm working on implementing a new forecast process at work and each budget owner will be submitting their forecast in a standardize template. In order for the budget owners to adopt this new process, it needs to be as easy as possible. To that point, they will enter all expense on a sub budget by month across a year (as seen in the first table below). I want to take their deliverable and modify it programmatically so that each month is on its own row (please see second table) to make a flat file that I can slice and dice. Can anyone provide a macro that will perform such a task?

[TABLE="width: 500"]
<tbody>[TR]
[TD][TABLE="width: 700"]
<tbody>[TR]
[TD]Number[/TD]
[TD]Street[/TD]
[TD]Budget[/TD]
[TD]Sub Budget[/TD]
[TD]Total[/TD]
[TD]Mar[/TD]
[TD]Apr[/TD]
[TD]May[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]Bathroom 1[/TD]
[TD]5000[/TD]
[TD]2000[/TD]
[TD]2000[/TD]
[TD]1000[/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]12000[/TD]
[TD]4000[/TD]
[TD]4000[/TD]
[TD]4000[/TD]
[/TR]
[TR]
[TD]234[/TD]
[TD]Seattle[/TD]
[TD]Exterior[/TD]
[TD]Landscaping[/TD]
[TD]10000[/TD]
[TD][/TD]
[TD]10000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]234[/TD]
[TD]Seattle[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]8000[/TD]
[TD]4000[/TD]
[TD]4000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: outer_border, width: 700"]
<tbody>[TR]
[TD]Number[/TD]
[TD]Street[/TD]
[TD]Budget[/TD]
[TD]Sub Budget[/TD]
[TD]Amount[/TD]
[TD]Month[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]Bathroom 1[/TD]
[TD]2000[/TD]
[TD]Mar
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]Bathroom 1[/TD]
[TD]2000[/TD]
[TD]Apr[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]Bathroom 1[/TD]
[TD]1000[/TD]
[TD]May[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]4000[/TD]
[TD]Mar[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]4000[/TD]
[TD]Apr[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]222[/TD]
[TD]Montreal[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]4000[/TD]
[TD]May[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]234[/TD]
[TD]Seattle[/TD]
[TD]Exterior[/TD]
[TD]Landscaping[/TD]
[TD]10000[/TD]
[TD]Apr[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]234[/TD]
[TD]Seattle[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]4000[/TD]
[TD]Mar[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]234[/TD]
[TD]Seattle[/TD]
[TD]Interior[/TD]
[TD]*******[/TD]
[TD]4000[/TD]
[TD]Apr[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG03Aug47
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nAc [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range("A1").CurrentRegion
ReDim nRay(1 To 6, 1 To 1)
nRay(1, 1) = "Number": nRay(2, 1) = "Street": nRay(3, 1) = "Budget": nRay(4, 1) = "Sub Budget": nRay(5, 1) = "Amount": nRay(6, 1) = "Month"
Rw = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
 [COLOR="Navy"]For[/COLOR] nAc = 6 To UBound(Ray, 2)
   [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, nAc)) [COLOR="Navy"]Then[/COLOR]
        Rw = Rw + 1
        ReDim Preserve nRay(1 To 6, 1 To Rw)
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 6
            [COLOR="Navy"]If[/COLOR] Ac = 5 [COLOR="Navy"]Then[/COLOR]
                nRay(Ac, Rw) = Ray(n, nAc)
            [COLOR="Navy"]ElseIf[/COLOR] Ac = 6 [COLOR="Navy"]Then[/COLOR]
                nRay(Ac, Rw) = Ray(1, nAc)
            [COLOR="Navy"]Else[/COLOR]
                nRay(Ac, Rw) = Ray(n, Ac)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] nAc
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(Rw, 6)
   .Value = Application.Transpose(nRay)
   .Borders.Weight = 2
   .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick