VBA Solution to insert number of rows based on condition

C

Chengo

Board Regular
Joined
Mar 14, 2012
Messages
50
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:
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Type
[/TD]
[TD]Country
[/TD]
[TD]Id
[/TD]
[TD]Deadline
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[/TR]
[TR]
[TD]Flat
[/TD]
[TD]Germany
[/TD]
[TD]234567
[/TD]
[TD]02/02/2018
[/TD]
[/TR]
[TR]
[TD]Shed
[/TD]
[TD]Poland
[/TD]
[TD]543212
[/TD]
[TD]03/03/2018
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Finland
[/TD]
[TD]568445
[/TD]
[TD]02/02/2018
[/TD]
[/TR]
[TR]
[TD]Flat
[/TD]
[TD]Spain
[/TD]
[TD]958476
[/TD]
[TD]01/01/2018
[/TD]
[/TR]
[TR]
[TD]Shed
[/TD]
[TD]France
[/TD]
[TD]476940
[/TD]
[TD]04/04/2018
[/TD]
[/TR]
</tbody>[/TABLE]

Requirement Sheet:
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]House
[/TD]
[TD]Weeks
[/TD]
[TD][/TD]
[TD]Flat
[/TD]
[TD]Weeks
[/TD]
[TD][/TD]
[TD]Shed
[/TD]
[TD]Weeks
[/TD]
[/TR]
[TR]
[TD]Task1
[/TD]
[TD]-6
[/TD]
[TD][/TD]
[TD]Task1
[/TD]
[TD]-4
[/TD]
[TD][/TD]
[TD]Task1
[/TD]
[TD]-4
[/TD]
[/TR]
[TR]
[TD]Task2
[/TD]
[TD]-5
[/TD]
[TD][/TD]
[TD]Task2
[/TD]
[TD]-3
[/TD]
[TD][/TD]
[TD]Task2
[/TD]
[TD]-3
[/TD]
[/TR]
[TR]
[TD]Task3
[/TD]
[TD]-3
[/TD]
[TD][/TD]
[TD]Task3
[/TD]
[TD]0[/TD]
[TD][/TD]
[TD]Task3
[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Task4
[/TD]
[TD]-3
[/TD]
[TD][/TD]
[TD]Task4
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD]Task4
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]Task5
[/TD]
[TD]-1
[/TD]
[TD][/TD]
[TD]Task5
[/TD]
[TD]2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Task6
[/TD]
[TD]0[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Task7
[/TD]
[TD]1
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Task8
[/TD]
[TD]3
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Task9
[/TD]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Task10
[/TD]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Task List Sheet
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Type
[/TD]
[TD]Country
[/TD]
[TD]Id
[/TD]
[TD]Deadline
[/TD]
[TD]Task Name
[/TD]
[TD]Task Date
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task1
[/TD]
[TD]20/11/2017
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task2
[/TD]
[TD]27/11/2017
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task3
[/TD]
[TD]11/12/2017
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task4
[/TD]
[TD]11/12/2017
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task5
[/TD]
[TD]25/12/2017
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task6
[/TD]
[TD]01/01/2018
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task7
[/TD]
[TD]08/01/2018
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task8
[/TD]
[TD]22/01/2018
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task9
[/TD]
[TD]29/01/2018
[/TD]
[/TR]
[TR]
[TD]House
[/TD]
[TD]Austria
[/TD]
[TD]123456
[/TD]
[TD]01/01/2018
[/TD]
[TD]Task10
[/TD]
[TD]29/01/2018
[/TD]
[/TR]
</tbody>[/TABLE]


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!
 
Last edited:

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
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.
 
Upvote 0
Hi give this a go
Code: 
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
ABCDEFGH
1HouseWeeksFlatWeeksShedWeeks
2Task1-6Task1-4Task1-4
3Task2-5Task2-3Task2-3
4Task3-3Task30Task30
5Task4-3Task41Task41
6Task5-1Task52
7Task60
8Task71
9Task83
10Task94
11Task104
Page1
 
Last edited:
Upvote 0
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?
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
Give this a go
Code: 
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
 
Upvote 0
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.
 
Upvote 0
Add the 2 lines in red, to the end of the macro
Code: 
    Columns(6).Delete
    [COLOR="#FF0000"]Range("E1").Value = "TaskName"
    Range("F1").Value = "TaskDate"
[/COLOR]
End Sub
 
Upvote 0
Thank you very much! It has solved the issue I was facing making my data manipulation much more automated.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
VBA - copy/paste (same) range several times next to eachother in different sheets incl. formatting
Replies
5
Views
1K
CaptnAbraham
C
K
  • Solved
Populate Data Based on Criteria
2
Replies
13
Views
783
Fluff
Fluff
D
  • Question Question
Using VBA/Macros to Duplicate Sheets and Inserting Individual Rows from Table
Replies
2
Views
887
donnington
D
L
  • Question Question
next date but not equal to saturday or sunday
Replies
3
Views
783
Fluff
Fluff
D
  • Question Question
Copying Rows from one table to another based on conditions
Replies
8
Views
895
vcoolio
V

Forum statistics

Threads
1,223,248
Messages
6,171,021
Members
452,374
Latest member
keccles

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