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!
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
Try this;-
NB:- The results are in sheet2 columns "A & B".
NB:- The results will Overwrite data in those columns and replace that data with only the Results from Sheet1, for weeks that have "Actions"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG12Feb10
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Wk [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[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] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
     [COLOR="Navy"]For[/COLOR] Ac = 1 To 52
        [COLOR="Navy"]If[/COLOR] Dn.Offset(, Ac).Value <> "" [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Offset(, Ac).Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Offset(, Ac).Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
            [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Offset(, Ac).Value).exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Offset(, Ac).Value).Add (Dn.Value), Rng(1).Offset(-1, Ac).Value
            [COLOR="Navy"]Else[/COLOR]
                Dic(Dn.Offset(, Ac).Value).Item(Dn.Value) = Dic(Dn.Offset(, Ac).Value).Item(Dn.Value) _
                & ", " & Rng(1).Offset(-1, Ac).Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
   
   
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
 .Range("A:B").ClearContents
[COLOR="Navy"]For[/COLOR] Wk = 1 To 52
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
       [COLOR="Navy"]If[/COLOR] Val(k) = Wk [COLOR="Navy"]Then[/COLOR]
         c = c + 1
        .Cells(c, 1) = "Week " & k
         c = c + 1
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
                .Cells(c, 1) = p
                Sp = Split(Dic(k).Item(p), ", ")
                    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
                        .Cells(c, 2) = Sp(n)
                        c = c + 1
                    [COLOR="Navy"]Next[/COLOR] n
            [COLOR="Navy"]Next[/COLOR] p
      [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]Next[/COLOR] Wk
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
At first glance, you used a button, is there a possibility to do it without button when values change?
First, I'm gonna have a look! Thanks for your input!! :)
 
Upvote 0
Try this:-
This code will run when you alter any number (Relating to weeks) in your data Columns "D to BC"
This code needs to be placed in the "Worksheet Module" for sheet1

To load code:-
Copy code
Right click sheet1 tab, Select "View Code", code window appears.
Paste Code into code window.
Close "Code Window"
'####
To run code Change/Enter any number in Columns "D to BC", click "Enter"
Sheet2 should be updated.
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] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] k           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p           [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Wk [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[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)
[COLOR="Navy"]If[/COLOR] Not Intersect(nRng, Target) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
     [COLOR="Navy"]For[/COLOR] Ac = 1 To 52
        [COLOR="Navy"]If[/COLOR] Dn.Offset(, Ac).Value <> "" [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Offset(, Ac).Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Offset(, Ac).Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
            [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Offset(, Ac).Value).exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Offset(, Ac).Value).Add (Dn.Value), Rng(1).Offset(-1, Ac).Value
            [COLOR="Navy"]Else[/COLOR]
                Dic(Dn.Offset(, Ac).Value).Item(Dn.Value) = Dic(Dn.Offset(, Ac).Value).Item(Dn.Value) _
                & ", " & Rng(1).Offset(-1, Ac).Value
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
   
   
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
 .Range("A:B").ClearContents
[COLOR="Navy"]For[/COLOR] Wk = 1 To 52
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
       [COLOR="Navy"]If[/COLOR] Val(k) = Wk [COLOR="Navy"]Then[/COLOR]
         c = c + 1
        .Cells(c, 1) = "Week " & k
         c = c + 1
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
                .Cells(c, 1) = p
                Sp = Split(Dic(k).Item(p), ", ")
                    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
                        .Cells(c, 2) = Sp(n)
                        c = c + 1
                    [COLOR="Navy"]Next[/COLOR] n
            [COLOR="Navy"]Next[/COLOR] p
      [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]Next[/COLOR] Wk
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
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
167
Smerdis13
Smerdis13
P
  • Question
copy data from one column and paste to another as values for multiple worksheet
Replies
0
Views
316
priisha
P
F
  • Solved
Data Validation List - Auto update cell values with a twist
Replies
1
Views
975
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
242
BAQI
B
E
  • Solved
FILTER function to return ONLY records with most recent date
Replies
5
Views
426
Fluff
Fluff

Forum statistics

Threads
1,215,491
Messages
6,125,107
Members
449,205
Latest member
ralemanygarcia

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