VBA code modification to insert row to a table instead of entire worksheet

[kelly mort]

Is there a way to add only a range of cells instead of entire row? Here, I will like to insert from Col B to Col O. I have other data adjacent the range B:O and the entire row is interfering with the layout. I will be more than happy to find a work around. Thanks in advance.

        .Rows(i).Insert xlUp

Full code is as below

Sub InsertRowsThenAdd()
Dim i&, j&, k&, n&, q&, x&, r As Range, va, y As Double, z As Double, lr&
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Sheet1")
        lr = .Range("D" & .Rows.Count).End(xlUp).Row
    For i = lr To 4 Step -1
        Do While .Cells(i, "D") = .Cells(i - 1, "D")
            i = i - 1
        Loop
        If i = 4 Then Exit For
        .Rows(i).Insert xlUp
    Next i
    n = .Range("D" & .Rows.Count).End(xlUp).Row
    q = 4
    For Each r In .Range("D4:D" & n + 1).SpecialCells(xlCellTypeBlanks)
        For k = 5 To 15 Step 2
            x = r.Row
            .Cells(x, k) = WorksheetFunction.SumIf(.Range(.Cells(q, k), .Cells(x - 1, k)), ">0")
            Select Case k
                Case 5, 7, 9, 11, 13
                    y = y + .Cells(x, k)
                Case 15
                    If .Cells(x, k) > 0 Then
                        z = z + .Cells(x, k)
                    End If
            End Select
            .Cells(x, k).Font.Bold = True
            .Cells(x, k).Font.Color = RGB(0, 128, 128)
            .Cells(x, 3).Font.Bold = True
            .Cells(x, 3).Font.Color = RGB(0, 128, 128)
            .Cells(x, 3) = "SUB-TOTAL"
        Next k
        q = x + 1
    Next r
    .[M2] = y: .[O2] = z
    Application.ScreenUpdating = True
    Exit Sub
    On Error GoTo 0
End With
End Sub

 

[Peter_SSs]

Try making this change

<del>.Rows(i).Insert xlUp</del>
.Range("B" & i & ":O" & i).Insert Shift:=xlDown

 

[kelly mort]

Try making this change

<del>.Rows(i).Insert xlUp</del>
.Range("B" & i & ":O" & i).Insert Shift:=xlDown

Right on point!!!

Thanks Peter

 

[Peter_SSs]

Thanks Peter

You're welcome.

Another option for that line:

.Cells(i, 2).Resize(, 14).Insert Shift:=xlDown

 

[kelly mort]

You're welcome.

Another option for that line:

.Cells(i, 2).Resize(, 14).Insert Shift:=xlDown

I think I am in love with this line