Code to add row and content

[seeker123]

Hi everyone
I have a large table that is something like this

Ducting
Ducting First floor
Painting
Painting First floor
Isolation
Isolation First floor

<tbody>
</tbody>

and so on
I want to add rows for six floors and have a table like below

Ducting
Ducting first floor
Ducting Second floor
Ducting Third floor
Ducting forth Floor
Ducting fifth floor
Ducting sixth floor
Painting
Painting first floor
painting second floor
painting third floor
Painting fourth floor
painting fifth floor
painting sixth floor

<tbody>
</tbody>

can you help me?
thanks in advance

 

[Akuini]

Try this:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] A1084824A()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1084824-code-add-row-content.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va, vb, arr, s1, s2, x

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
arr = Split([COLOR=brown]"Second Third Forth Fifth Sixth"[/COLOR])
va = Range([COLOR=brown]"A1"[/COLOR], Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))

[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]) * [COLOR=crimson]5[/COLOR], [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]1[/COLOR])

[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
    [COLOR=Royalblue]If[/COLOR] InStr([COLOR=crimson]1[/COLOR], va(i, [COLOR=crimson]1[/COLOR]), [COLOR=brown]"first floor"[/COLOR], [COLOR=crimson]1[/COLOR]) [COLOR=Royalblue]Then[/COLOR]
        s1 = Split(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=brown]" "[/COLOR])([COLOR=crimson]0[/COLOR])
            s2 = Split(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=brown]" "[/COLOR])([COLOR=crimson]2[/COLOR])
                j = j + [COLOR=crimson]1[/COLOR]
                    vb(j, [COLOR=crimson]1[/COLOR]) = va(i, [COLOR=crimson]1[/COLOR])
        [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x [COLOR=Royalblue]In[/COLOR] arr
            j = j + [COLOR=crimson]1[/COLOR]
            vb(j, [COLOR=crimson]1[/COLOR]) = s1 & [COLOR=brown]" "[/COLOR] & x & [COLOR=brown]" "[/COLOR] & s2
        [COLOR=Royalblue]Next[/COLOR]
    [COLOR=Royalblue]Else[/COLOR]
        j = j + [COLOR=crimson]1[/COLOR]
        vb(j, [COLOR=crimson]1[/COLOR]) = va(i, [COLOR=crimson]1[/COLOR])
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Range([COLOR=brown]"A1"[/COLOR]).Resize(j, [COLOR=crimson]1[/COLOR]) = vb
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[Yongle]

A different method to one used by @Akuini
- add an empty formatted row at bottom of data before you begin (Note ***)

To test
- double click on cell containing "Painting First floor" and row inserted containing "Painting Second floor"

Put this in SHEET module (right click sheet tab\ select view code \ paste into code window)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Dim cel As Range, arr, a As Long
    arr = Split("First,Second,Third,Fourth,Fifth,Sixth,Seventh,Eighth,Ninth,Tenth", ",")
    Set cel = ActiveCell
    Rows(cel.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    For a = 0 To UBound(arr)
        If InStr(1, cel, Trim(arr(a))) > 0 Then
            On Error Resume Next
            cel.Offset(1).Value = Replace(cel, arr(a), arr(a + 1))
            Exit For
        End If
    Next a
End Sub

Excel 2016 (Windows) 32 bit

	A​	B​	C​
1​	Ducting
2​	Ducting First floor
3​	Painting
4​	Painting First floor
5​	Painting Second floor
6​	Isolation
7​	Isolation First floor
8​	Isolation Second floor
9​			Note ** add a blank row with borders at foot of table​

Sheet: Sheet1