Changing the format/layout of an excel worksheet

[sleepyowl86]

I have a worksheet with over 3 months worth of data entry. My coworker claims she can't understand the layout. She wants me to change it from example 1 to example 2. Is there any easy way to do this without re-entering 3 months worth of work?

Example 1

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]WK#[/TD]
[TD]Date[/TD]
[TD]Accnt Name[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]7/9/15[/TD]
[TD]MY PLACE[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]8/6/15[/TD]
[TD]MY PLACE[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]8/13/15[/TD]
[TD]MY PLACE[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]8/20/15[/TD]
[TD]MY PLACE[/TD]
[/TR]
</tbody>[/TABLE]

Example 2
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Acct Name[/TD]
[TD]Wk 1[/TD]
[TD]Wk 2[/TD]
[TD]Wk 3[/TD]
[TD]Wk 4[/TD]
[/TR]
[TR]
[TD]My Place[/TD]
[TD]7/9/15[/TD]
[TD]8/6/15[/TD]
[TD]8/13/15[/TD]
[TD]8/20/15[/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this:-
Results sheet2

[COLOR="Navy"]Sub[/COLOR] MG16Sep15
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 2)
n = 1
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            Ray(1, 1) = "Account Name"
            Ray(n, 1) = Dn.Value: Ray(n, 2) = Dn.Offset(, -1).Value: Ray(1, 2) = "Wk " & Dn.Offset(, -2).Value
            .Add Dn.Value, Array(n, 2)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Dn.Value)
            Q(1) = Q(1) + 1
            oMax = Application.Max(Q(1), oMax)
            [COLOR="Navy"]If[/COLOR] UBound(Ray, 2) < oMax [COLOR="Navy"]Then[/COLOR] ReDim Preserve Ray(1 To Rng.Count, 1 To Q(1))
            Ray(1, Q(1) - 1) = "Wk " & Q(1) - 2
            Ray(Q(0), Q(1)) = Dn.Offset(, -1): Ray(1, Q(1)) = "Wk " & Dn.Offset(, -2).Value
            .Item(Dn.Value) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(n, oMax)
    .Value = Ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Domski]

You could use Index/Match to create the table. I'd stick with your format if it was me though as you'll find it much easier to analyse data entered in a list like that than if it's already in a table format.

Dom

 

[sleepyowl86]

Mick- I had to learn a new skill but that almost worked perfectly. The problem I'm having is its not changing the entire list.


Dom- Thank you, that's what I thought too. But she'll throw a fit til she gets her way

 

[sleepyowl86]

Mick-Never mind, It moved my starting list down so I thought it only changed half my list! It works great!

 

[Smitty]

You could also try a Pivot Table:

Excel 2012
	A	B	C	D	E
3		Week Number
4	Account	1	2	3	4
5	MY PLACE	07/09/15	08/06/15	08/13/15	08/20/15
Sheet4

HTH,

 

[MickG]

You're welcome