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

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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

B
  • Solved
VBA to Move Rows Based on Status in Excel
Replies
3
Views
650
Alex Blakenburg
A
D
  • Solved
Using Vlookup, If statements??
Replies
3
Views
228
Dprobasco
D
Smerdis13
  • Question Question
VBA to Get Output by check relations from Input
Replies
2
Views
310
Smerdis13
Smerdis13
C
  • Question Question
Searching using TextBox and ListBox
Replies
1
Views
279
campbell1093
C
T
  • Question Question
Copy and paste range of data to next available row on different sheet
2 3
Replies
22
Views
1K
Trae1170
T

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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