VBA - Insert two new rows based on Userform criteria and also copying the excel formula of a cell range

Question

This question is very tricky so I added more Images to make it better to understand ans this is my Excel sheet Looks like Gantt chart before adding anything.

In this Excel sheet the cells gets filled by a Userform and the cell values"G3" gets reduced based on "booked" value Cell "E4" and "F5"

Required Output: How to add new "members" in Column A based on the "Red" and "Blue" in between the members. Important is the Gantt Chart should also be added as it is for other members.

Output should look like below Image:

I was trying Row Insert method with below Code but it is only adding a new row but not fulfilling my requirement.

Sub Insert()
    'Select and find where to insert new row
    ActiveSheet.Range("A:A").Find(What:=Me.cboteam.Value, LookIn:=xlFormulas, Lookat:=xlWhole)
    ActiveCell.EntireRow.Insert
    ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown,CopyOrigin:=xlFormatFromLeftOrAbove
 End Sub

z32a7ul z32a7ul · Accepted Answer · 2019-08-15T13:15:58

Try this:

Sub Insert()
    'Select and find where to insert new row
    Dim rngFound As Range: Set rngFound = ActiveSheet.Range("A:A").Find(What:=Me.cboteam.Value, LookIn:=xlFormulas, Lookat:=xlWhole)
    rngFound.Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    rngFound.Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Debug.Print rngFound.Offset(1, 0).Resize(2, 1).Address
    rngFound.Resize(3, 1).EntireRow.FillDown
 End Sub

VBA - Insert two new rows based on Userform criteria and also copying the excel formula of a cell range

1 Answers