Code to add row and content

[seeker123]

Hi everyone
I have a large table that is something like this
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Ducting[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting First floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Painting[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Painting First floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Isolation[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Isolation First floor[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
and so on
I want to add rows for six floors and have a table like below
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Ducting[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting first floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting Second floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting Third floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting forth Floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting fifth floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ducting sixth floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Painting[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Painting first floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]painting second floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]painting third floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Painting fourth floor[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]painting fifth floor
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]painting sixth floor[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
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
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]

A​

[/th][th]

B​

[/th][th]

C​

[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

1​

[/td][td]Ducting[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

2​

[/td][td]Ducting First floor[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

3​

[/td][td]Painting[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

4​

[/td][td]Painting First floor[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

5​

[/td][td]Painting Second floor[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

6​

[/td][td]Isolation[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

7​

[/td][td]Isolation First floor[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

8​

[/td][td]Isolation Second floor[/td][td][/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]

9​

[/td][td][/td][td][/td][td]

Note **
add a blank row with borders at foot of table​

[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]