Macro: Create several rows of data based on existing data in new worksheet

P

pulsyyy

New Member
Joined
Feb 10, 2015
Messages
10
Hi all,

I have the following scenario at hand: In one worksheet I have an overview of items (1 row per item), with several columns of specifications per item (columns A through J). In column K, I have an operator I add manually, with two possible options "Yes" or "No". First row of data is row 2. Based on these two options I have a list of tasks that need to be completed, 15 tasks if the option is "Yes", 7 tasks if the option is "No".

Now I want to have a wholistic tracker in a new worksheet, which gives me all tasks needed for each item, with each task having its own row. The data should start in row 20.

Is this possible?

Thank you so much for your help!

Overview of items:
item
header 1header 2
header 3header 4header 5header 6header 7header 8header 9option
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9Yes
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9No

<colgroup><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Desired Tracker:
item
header 1header 2header 3header 4header 5header 6header 7header 8header 9optiontask
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 1task 1
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 2task 2
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 3task 3
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 4task 4
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 5task 5
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 6task 6
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 7task 7
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 8task 8
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 9task 9
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 10task 10
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 11task 11
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 12task 12
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 13task 13
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 14task 14
item 1item 1 - spec 1item 1 - spec 2item 1 - spec 3item 1 - spec 4item 1 - spec 5item 1 - spec 6item 1 - spec 7item 1 - spec 8item 1 - spec 9YesYes - task 15task 15
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 1task 1
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 2task 2
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 3task 3
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 4task 4
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 5task 5
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 6task 6
item 2item 2 - spec 1item 2 - spec 2item 2 - spec 3item 2 - spec 4item 2 - spec 5item 2 - spec 6item 2 - spec 7item 2 - spec 8item 2 - spec 9NoNo - task 7task 7

<colgroup><col span="11"><col><col></colgroup><tbody>
</tbody>

List of tasks:
OptionTask
Yes
task 1
Yestask 2
Yestask 3
Yestask 4
Yestask 5
Yestask 6
Yestask 7
Yestask 8
Yestask 9
Yestask 10
Yestask 11
Yestask 12
Yestask 13
Yestask 14
Yestask 15
Notask 1
Notask 2
Notask 3
Notask 4
Notask 5
Notask 6
Notask 7

<colgroup><col style="width:48pt" span="2" width="64"> </colgroup><tbody>
</tbody>
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
Perhaps this:-
Results Sheet2 , Starting row 20
Code: 
[COLOR="Navy"]Sub[/COLOR] MG25Jul53
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
c = 21
[COLOR="Navy"]For[/COLOR] n = 1 To Lst
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
        [COLOR="Navy"]If[/COLOR] n = 1 [COLOR="Navy"]Then[/COLOR]
          .Cells(20, 1).Resize(, 11).Value = Cells(1, 1).Resize(, 11).Value
           .Cells(20, 12) = "Task"
        [COLOR="Navy"]Else[/COLOR]
            num = IIf(Cells(n, 11) = "Yes", 15, 7)
            .Cells(c, 1).Resize(num, 11).Value = Cells(n, 1).Resize(, 11).Value
            .Cells(c, 12).Value = Cells(n, 11) & " - Task 1"
            .Cells(c, 12).AutoFill Destination:=.Cells(c, 12).Resize(num), Type:=xlFillSeries
            .Cells(c, 13).Value = "Task 1"
            .Cells(c, 13).AutoFill Destination:=.Cells(c, 13).Resize(num), Type:=xlFillSeries
            c = c + num
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Hi Mick,

thanks for the quick reply. The list of tasks would be stored in either a third worksheet or above the tracker I'm looking to build. It should not actually say "Task 1", "Task 2", etc, but rather the actual task, such as: "Set live date" (sorry for not making this clear earlier). I understand that having the list above the tracker would cause the tracker to start further down (which should be easy to adapt).

Is it possible to reflect that in the code?

Best,
Michael
 
Upvote 0
There are no specific "Tasks" like "Set Live date" in sheet "Overview of items", so where does the code get these "Tasks" from ???
or am I getting it wrong and the "Tracker" already exists.
Please explain how you would like the code to work and where it gets its data from.
 
Upvote 0
Hi Mick,

sorry for the confusion. Let me clarify:
Worksheet1 = Overview of items as in the table in my original post.
Worksheet2 = Range: A1:B23 = List of tasks, which can be filtered by "Yes" or "No"
Worksheet3 = Location of newly created tracker

The goal is to assign each item all the tasks of worksheet2, based on the value in column K of worksheet1 ("Yes" or "No").

The tracker should look like the "desired tracker" in my original post. It does not exist yet.
The tables in my original post are placeholders as I did not want to post any sensitive data on the board.

Hope this sheds some more light on my problem. Thanks again for your help!
 
Upvote 0
Try this :-
The result in sheet 3 are now based on sheet2 "options" and "tasks" as filtered, and the basic data in sheet 1.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG26Jul19
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet2").Cells(1).CurrentRegion.Resize(, 2)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sheets("Sheet3").UsedRange.ClearContents
[COLOR="Navy"]For[/COLOR] n = 2 To Rng.Count
[COLOR="Navy"]If[/COLOR] Not Rng(n, 1).Rows.Hidden [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Rng(n, 1).Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Rng(n, 1).Value, Rng(n, 2).Value
    [COLOR="Navy"]Else[/COLOR]
        Dic(Rng(n, 1).Value) = Dic(Rng(n, 1).Value) & "," & Rng(n, 2)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

Lst = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
c = 2
[COLOR="Navy"]For[/COLOR] n = 1 To Lst
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet3")
        [COLOR="Navy"]If[/COLOR] n = 1 [COLOR="Navy"]Then[/COLOR]
            .Cells(1, 1).Resize(, 11).Value = Cells(1, 1).Resize(, 11).Value
            .Cells(1, 12) = "Task"
        [COLOR="Navy"]ElseIf[/COLOR] Dic.exists(Sheets("Sheet1").Cells(n, 11).Value) [COLOR="Navy"]Then[/COLOR]
            Sp = Split(Dic(Sheets("Sheet1").Cells(n, 11).Value), ",")
            num = UBound(Sp) + 1
           .Cells(c, 1).Resize(num, 11).Value = Cells(n, 1).Resize(, 11).Value
            .Cells(c, 12).Resize(num).Value = Application.Transpose(Sp)
            c = c + num
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

sorry for not getting back earlier. Had some other things I had to work on. The macro above only copies the tasks but not overview of items related to the task. Is it possible to integrate this?

Thanks a lot for your help!
Michael
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG05Aug31
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet2").Cells(1).CurrentRegion.Resize(, 2)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sheets("Sheet3").UsedRange.ClearContents
[COLOR="Navy"]For[/COLOR] n = 2 To Rng.Count
[COLOR="Navy"]If[/COLOR] Not Rng(n, 1).Rows.Hidden [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Rng(n, 1).Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Rng(n, 1).Value, Rng(n, 2).Value
    [COLOR="Navy"]Else[/COLOR]
        Dic(Rng(n, 1).Value) = Dic(Rng(n, 1).Value) & "," & Rng(n, 2)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

Lst = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
c = 2
[COLOR="Navy"]For[/COLOR] n = 1 To Lst
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet3")
        [COLOR="Navy"]If[/COLOR] n = 1 [COLOR="Navy"]Then[/COLOR]
            .Cells(1, 1).Resize(, 11).Value = Sheets("Sheet1").Cells(1, 1).Resize(, 11).Value
            .Cells(1, 12) = "Task"
        [COLOR="Navy"]ElseIf[/COLOR] Dic.exists(Sheets("Sheet1").Cells(n, 11).Value) [COLOR="Navy"]Then[/COLOR]
            Sp = Split(Dic(Sheets("Sheet1").Cells(n, 11).Value), ",")
            num = UBound(Sp) + 1
           .Cells(c, 1).Resize(num, 11).Value = Sheets("Sheet1").Cells(n, 1).Resize(, 11).Value
            .Cells(c, 12).Resize(num).Value = Application.Transpose(Sp)
            c = c + num
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Difference between dates based on follow on work
Replies
5
Views
438
Alex Blakenburg
A
J
  • Solved
Text to column and then stack
Replies
5
Views
205
Peter_SSs
Peter_SSs
D
  • Question
Copy/Pasting rows of a table to specific cells of a separate worksheet template and exporting as a new file.
Replies
0
Views
26
DjentChicken
D
B
  • Question
Macro to find and count between tabs based on highlighted color
Replies
5
Views
85
Jeffrey Mahoney
Jeffrey Mahoney
M
  • Solved
FILTER Function & MAP/LAMBDA through Different Ranges & Arrays
Replies
1
Views
140
Fluff
Fluff

Forum statistics

Threads
1,216,073
Messages
6,128,645
Members
449,461
Latest member
kokoanutt

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