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:
[TABLE="class: grid, width: 1256"]
<colgroup><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]item
[/TD]
[TD]header 1[/TD]
[TD]header 2
[/TD]
[TD]header 3[/TD]
[TD]header 4[/TD]
[TD]header 5[/TD]
[TD]header 6[/TD]
[TD]header 7[/TD]
[TD]header 8[/TD]
[TD]header 9[/TD]
[TD]option[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[/TR]
</tbody>[/TABLE]

Desired Tracker:
[TABLE="class: grid, width: 849"]
<colgroup><col span="11"><col><col></colgroup><tbody>[TR]
[TD]item
[/TD]
[TD]header 1[/TD]
[TD]header 2[/TD]
[TD]header 3[/TD]
[TD]header 4[/TD]
[TD]header 5[/TD]
[TD]header 6[/TD]
[TD]header 7[/TD]
[TD]header 8[/TD]
[TD]header 9[/TD]
[TD]option[/TD]
[TD]task[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 1[/TD]
[TD]task 1[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 2[/TD]
[TD]task 2[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 3[/TD]
[TD]task 3[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 4[/TD]
[TD]task 4[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 5[/TD]
[TD]task 5[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 6[/TD]
[TD]task 6[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 7[/TD]
[TD]task 7[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 8[/TD]
[TD]task 8[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 9[/TD]
[TD]task 9[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 10[/TD]
[TD]task 10[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 11[/TD]
[TD]task 11[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 12[/TD]
[TD]task 12[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 13[/TD]
[TD]task 13[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 14[/TD]
[TD]task 14[/TD]
[/TR]
[TR]
[TD]item 1[/TD]
[TD]item 1 - spec 1[/TD]
[TD]item 1 - spec 2[/TD]
[TD]item 1 - spec 3[/TD]
[TD]item 1 - spec 4[/TD]
[TD]item 1 - spec 5[/TD]
[TD]item 1 - spec 6[/TD]
[TD]item 1 - spec 7[/TD]
[TD]item 1 - spec 8[/TD]
[TD]item 1 - spec 9[/TD]
[TD]Yes[/TD]
[TD]Yes - task 15[/TD]
[TD]task 15[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 1[/TD]
[TD]task 1[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 2[/TD]
[TD]task 2[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 3[/TD]
[TD]task 3[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 4[/TD]
[TD]task 4[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 5[/TD]
[TD]task 5[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 6[/TD]
[TD]task 6[/TD]
[/TR]
[TR]
[TD]item 2[/TD]
[TD]item 2 - spec 1[/TD]
[TD]item 2 - spec 2[/TD]
[TD]item 2 - spec 3[/TD]
[TD]item 2 - spec 4[/TD]
[TD]item 2 - spec 5[/TD]
[TD]item 2 - spec 6[/TD]
[TD]item 2 - spec 7[/TD]
[TD]item 2 - spec 8[/TD]
[TD]item 2 - spec 9[/TD]
[TD]No[/TD]
[TD]No - task 7[/TD]
[TD]task 7[/TD]
[/TR]
</tbody>[/TABLE]

List of tasks:
[TABLE="class: grid, width: 128"]
<colgroup><col style="width:48pt" span="2" width="64"> </colgroup><tbody>[TR]
[TD="width: 64"]Option[/TD]
[TD="width: 64"]Task[/TD]
[/TR]
[TR]
[TD]Yes
[/TD]
[TD]task 1[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 2[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 3[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 4[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 5[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 6[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 7[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 8[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 9[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 10[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 11[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 12[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 13[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 14[/TD]
[/TR]
[TR]
[TD]Yes[/TD]
[TD]task 15[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 1[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 2[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 3[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 4[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 5[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 6[/TD]
[/TR]
[TR]
[TD]No[/TD]
[TD]task 7[/TD]
[/TR]
</tbody>[/TABLE]
 
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

Joneye
  • Question Question
Index & Match or Other Look up Advice
Replies
2
Views
100
Joneye
Joneye
E
  • Question Question
If statement
Replies
4
Views
158
xlhelp15
xlhelp15
A
  • Question Question
VBA Coding
Replies
2
Views
80
ADJ2RGJ
A
R
  • Question Question
Required Transposed Values instead of Row Items of Duplicate Invoice no with Each GSTIN which is displaying the SUM of 12+18+28
Replies
1
Views
115
rk_rk
R
C
  • Question Question
Create a new row for every date in row and create multiple copies of data to new worksheet based on cell number value for each date in the row VBA
Replies
0
Views
200
Chris258
C

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