VBA Solution to insert number of rows based on condition

[Chengo]

Hi there,

I am trying to figure out an elegant VBA method to insert certain number of rows with added data based on conditions identified in different sheet.

Data Sheet:

Type	Country	Id	Deadline
House	Austria	123456	01/01/2018
Flat	Germany	234567	02/02/2018
Shed	Poland	543212	03/03/2018
House	Finland	568445	02/02/2018
Flat	Spain	958476	01/01/2018
Shed	France	476940	04/04/2018

<tbody>
</tbody>

Requirement Sheet:

House	Weeks		Flat	Weeks		Shed	Weeks
Task1	-6		Task1	-4		Task1	-4
Task2	-5		Task2	-3		Task2	-3
Task3	-3		Task3	0		Task3	0
Task4	-3		Task4	1		Task4	1
Task5	-1		Task5	2
Task6	0
Task7	1
Task8	3
Task9	4
Task10	4

<tbody>
</tbody>

Task List Sheet

Type	Country	Id	Deadline	Task Name	Task Date
House	Austria	123456	01/01/2018	Task1	20/11/2017
House	Austria	123456	01/01/2018	Task2	27/11/2017
House	Austria	123456	01/01/2018	Task3	11/12/2017
House	Austria	123456	01/01/2018	Task4	11/12/2017
House	Austria	123456	01/01/2018	Task5	25/12/2017
House	Austria	123456	01/01/2018	Task6	01/01/2018
House	Austria	123456	01/01/2018	Task7	08/01/2018
House	Austria	123456	01/01/2018	Task8	22/01/2018
House	Austria	123456	01/01/2018	Task9	29/01/2018
House	Austria	123456	01/01/2018	Task10	29/01/2018

<tbody>
</tbody>

Essentially I want to accomplish the following:
1. Evaluate row on Data sheet.
2. Compare Type value in row, then look up that type on Requirements sheet and identify the number of tasks
3. Insert the number of rows into Task List sheet by copying all the cells in that row
4. Append Task Name and Task Date at the end of each row.
Task Date is the number of work weeks before (negative) or after (positive) the Deadline.
5. Return to Data sheet and perform same exercise with next row etc.

Example:
House has 10 tasks so Task List sheet should have 10 rows for each respective row from Data sheet that has House specified.

Any ideas anyone?

Thanks in advance!

 

[Chengo]

Just to add that Requirements sheet layout can be changed if necessary. I don't mind if there is 3 sheets for requirements: 1 for each type.

 

[Fluff]

Hi give this a go

Sub addrws()

    Dim Rw As Long
    Dim ReqSht As Worksheet
    
    Set ReqSht = Sheets("[COLOR=#ff0000]Page1[/COLOR]")
    
    For Rw = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Select Case Range("A" & Rw)
            Case "Shed"
                Rows(Rw).Offset(1).Resize(3).Insert
                Range("A" & Rw).Resize(4, 4).Filldown
                Range("E" & Rw).Resize(4, 2).Value = ReqSht.Range("G2:H5").Value
                With Range("G" & Rw).Resize(4)
                    .FormulaR1C1 = "=rc[-3]+(rc[-1]*7)"
                    .Value = .Value
                End With
            Case "Flat"
                Rows(Rw).Offset(1).Resize(4).Insert
                Range("A" & Rw).Resize(5, 4).Filldown
                Range("E" & Rw).Resize(5, 2).Value = ReqSht.Range("D2:E6").Value
                With Range("G" & Rw).Resize(5)
                    .FormulaR1C1 = "=rc[-3]+(rc[-1]*7)"
                    .Value = .Value
                End With
            Case "House"
                 Rows(Rw).Offset(1).Resize(9).Insert
                Range("A" & Rw).Resize(10, 4).Filldown
                Range("E" & Rw).Resize(10, 2).Value = ReqSht.Range("A2:E11").Value
                With Range("G" & Rw).Resize(10)
                    .FormulaR1C1 = "=rc[-3]+(rc[-1]*7)"
                    .Value = .Value
                End With
        End Select
    Next Rw
    Columns(6).Delete

End Sub

Change the part in red to match the requirements sheet name.
This is based on your data on both sheets starting in A1
My requirements sheet was set as follows.

Excel 2013 32 bit
	A	B	C	D	E	F	G	H
1	House	Weeks		Flat	Weeks		Shed	Weeks
2	Task1	-6		Task1	-4		Task1	-4
3	Task2	-5		Task2	-3		Task2	-3
4	Task3	-3		Task3	0		Task3	0
5	Task4	-3		Task4	1		Task4	1
6	Task5	-1		Task5	2
7	Task6	0
8	Task7	1
9	Task8	3
10	Task9	4
11	Task10	4
Page1

 

[Chengo]

Thank you very much for this! One ask if I may - Would it be possible to have all these rows generated in 3rd sheet so that my original data can remain unaltered?

 

[Fluff]

Not a problem.
What is the name of your data sheet?
Will the 3rd sheet already exist, or does the macro need to create it?
If it already exists
A) what is it's name?
B) do you want any existing data deleted?

 

[Chengo]

Let's call it "TaskList". I guess it could always exist. Do not want to delete any existing data.

Thank you for looking into that.

 

[Fluff]

Give this a go

Sub addrws()

    Dim Rw As Long
    Dim ReqSht As Worksheet
    
    Set ReqSht = Sheets("Page1")
    
    Sheets("Data").Copy after:=Sheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = "TaskList"
    On Error GoTo 0
    
    For Rw = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        Select Case Range("A" & Rw)
            Case "Shed"
                Rows(Rw).Offset(1).Resize(3).Insert
                Range("A" & Rw).Resize(4, 4).FillDown
                Range("E" & Rw).Resize(4, 2).Value = ReqSht.Range("G2:H5").Value
                With Range("G" & Rw).Resize(4)
                    .FormulaR1C1 = "=rc[-3]+(rc[-1]*7)"
                    .Value = .Value
                End With
            Case "Flat"
                Rows(Rw).Offset(1).Resize(4).Insert
                Range("A" & Rw).Resize(5, 4).FillDown
                Range("E" & Rw).Resize(5, 2).Value = ReqSht.Range("D2:E6").Value
                With Range("G" & Rw).Resize(5)
                    .FormulaR1C1 = "=rc[-3]+(rc[-1]*7)"
                    .Value = .Value
                End With
            Case "House"
                 Rows(Rw).Offset(1).Resize(9).Insert
                Range("A" & Rw).Resize(10, 4).FillDown
                Range("E" & Rw).Resize(10, 2).Value = ReqSht.Range("A2:E11").Value
                With Range("G" & Rw).Resize(10)
                    .FormulaR1C1 = "=rc[-3]+(rc[-1]*7)"
                    .Value = .Value
                End With
        End Select
    Next Rw
    Columns(6).Delete

End Sub

 

[Chengo]

Thank you for the updated code! It works nicely and keeps the original dataset intact. There's just one tiny thing - how do I name the column E and column F "TaskName" and "TaskDate" respectively? These are columns on newly created TaskList sheet without headers.

Thank you in advance! You've been very patient with me.

 

[Fluff]

Add the 2 lines in red, to the end of the macro

    Columns(6).Delete
    [COLOR="#FF0000"]Range("E1").Value = "TaskName"
    Range("F1").Value = "TaskDate"
[/COLOR]
End Sub

 

[Chengo]

Thank you very much! It has solved the issue I was facing making my data manipulation much more automated.