Add rows with actions in different weeks based on range values

D

ddewilt

New Member
Joined
Sep 18, 2017
Messages
26
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!
 
Sort by date Sort by votes

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Crap, this code doesn't work on Excel for MAC..something with ActiveX can't create object..How can I solve this?
 
Last edited:
Upvote 0
You are right ,the code will not work with a "Mac", as I have not got one, I have not got an answer. Sorry !!!
 
Upvote 0
Try this code, that does not use the "Scripting Dictionary" see if that works on your Mac".
The code is also a "Worksheet change" Event, so load a previously stated.
Code: 
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"]With[/COLOR] Sheets("Sheet2")
 .Range("A:B").ClearContents
    [COLOR="Navy"]For[/COLOR] n = 1 To 52
        [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
                .Cells(c, 1) = Cells(R.Row, "C")
                .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"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Wauw man! Thanks thanks thanks! That did it! Now I can try the Formatting of cells and grouping of weeks...After that I need a dropdown on Sheet 2 after every action..(I hope this VBA-noob will learn quickly how to do this haha ;)), then it's all complete.. loooooong way to go I think haha
 
Upvote 0
Hi MickG,

If I have 2 actions for John in Week 1, his name is shown before every action. Before, you had 1 name and then all the actions..is it in the code:
Code: 
.Cells(c, 2) = Cells(2, R.Column)
where I have to change something, or is it the
Code: 
For Each R In ray(n)
?
 
Last edited:
Upvote 0
Try this replacement code:-
Code: 
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"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks! Worked! I have added some text/cell formatting and wanted to group the weeks using
Code: 
.Cells(c, 2).EntireRow.Group
under
Code: 
Next R
Tried it on many places, but all he does is group 1 record of every week..?
 
Upvote 0
You must log in or register to reply here.

Similar threads

Smerdis13
  • Question
VBA to Get Output by check relations from Input
Replies
2
Views
182
Smerdis13
Smerdis13
P
  • Question
copy data from one column and paste to another as values for multiple worksheet
Replies
0
Views
328
priisha
P
F
  • Solved
Data Validation List - Auto update cell values with a twist
Replies
1
Views
1K
Fritz23
F
B
  • Question
Macro that takes data from one sheet, adds and puts it on another sheet and deletes the information on the first.
Replies
6
Views
259
BAQI
B
E
  • Solved
FILTER function to return ONLY records with most recent date
Replies
5
Views
468
Fluff
Fluff

Forum statistics

Threads
1,216,100
Messages
6,128,827
Members
449,470
Latest member
Subhash Chand

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