Add rows with actions in different weeks based on range values

[ddewilt]

Hi,

I've got case right here..
I have 2 sheets: On Sheet 1 on row 3 in Column E there's a name and from Column F to AD are weeknumbers (1 to 51). Per action you can fill in a weeknumber which that action has to take place. On Sheet 2 I need to insert a name with rows depending how many actions that week need to be done.

SHEET 1
Toprow (row2), beginning on column E and the actions from F to AD:
Columns: E F G ... .... ...
ROW 2 :Name | Action 1 | Action 2 | Action 3 | Action 4 | Action 5 | Action 6 | Action 7 | Action 8 | Action 9 | and so on...

Datarow (row3 to row X) where on column E is the name and F to AD presenting the weeknumbers:
ROW 3 :John | 1 | 5 | 15 | 1 | ...


Now, on Sheet 2, I have the weeknumbers below eachother in Column A:

SHEET 2
Week 1

Week 2

....

What I need is to put the name in the right week with the right actions (insert rows based on how many 1's, 2's etc.)... So, if John has actions in week 1, his name has to be under Week 1, if there are two 1's in the range F to AD, there has to be 2 rows inserted with the name of the actions:

SHEET 2
Week 1
Name | Actionname
John | Action 1
Action 4
etc..

Has somebody any idea to do this?
Don't hasitate to ask any questions..

Thanks in advance!

 

[MickG]

Try this:-
The added code should first "Ungroup" any grouped Rows, then "Group" rows based on each "Week"

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng        [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac1         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac2         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R           [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("C3", .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] nRng = Rng.Offset(, 1).Resize(, 52)
ReDim ray(1 To 52) [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]If[/COLOR] Not Intersect(nRng, Target) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] Ac1 = 1 To 52
        [COLOR="Navy"]For[/COLOR] Ac2 = 1 To 52
            [COLOR="Navy"]If[/COLOR] Dn.Offset(, Ac2).Value = Ac1 [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] ray(Ac1) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] ray(Ac1) = Dn.Offset(, Ac2) Else [COLOR="Navy"]Set[/COLOR] ray(Ac1) = Union(ray(Ac1), Dn.Offset(, Ac2))
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac2
    [COLOR="Navy"]Next[/COLOR] Ac1
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
 .Range("A:B").ClearContents
    [COLOR="Navy"]For[/COLOR] n = 1 To 52
        Temp = ""
        [COLOR="Navy"]If[/COLOR] Not ray(n) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            .Cells(c, 1) = "Week " & ray(n)(1)
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] ray(n)
                c = c + 1
                [COLOR="Navy"]If[/COLOR] Not Temp = Cells(R.Row, "C") [COLOR="Navy"]Then[/COLOR]
                    Temp = Cells(R.Row, "C")
                    .Cells(c, 1) = Cells(R.Row, "C")
                [COLOR="Navy"]End[/COLOR] If
                .Cells(c, 2) = Cells(2, R.Column)
            [COLOR="Navy"]Next[/COLOR] R
        [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]If[/COLOR] Not ray(n) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] c = c + 1
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
.Rows.Ungroup
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] GoTo 0
[COLOR="Navy"]Set[/COLOR] Rng = .Range("B:B").SpecialCells(xlCellTypeConstants)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
    Dn.Offset(-1).Resize(Dn.Rows.Count + 1).Rows.Group
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick