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

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,728
Office Version
2016
Platform
Windows
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.
Code:
        .Rows(i).Insert xlUp

Full code is as below


Code:
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
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,669
Office Version
365
Platform
Windows
Try making this change
Code:
<del>.Rows(i).Insert xlUp</del>
.Range("B" & i & ":O" & i).Insert Shift:=xlDown
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,090,142
Messages
5,412,696
Members
403,442
Latest member
keowinvip1

This Week's Hot Topics

Top