0

I need to insert an additional record before the next value in a list changes.

1   4   j
2   4   g
3   5   h
4   5   f
5   5   v
6   5   y
7   5   f
8   6   f
9   6   g
10  8   j

ie Lines 2, 7, 9 would be duplicated and inserted before the next line. Note working is from the bottom up. I thought maybe Selection.Offset(1, 0).Select

Sub InsertRowsWithNewValues()
' Note: hard coded to "Sheet1", ChkCol
    Dim LastRowcheck As Long, n1 As Long, ChkCol As Long

ChkCol = 2
MsgBox ("Execute on column: " + Str(ChkCol))

    With Worksheets("Sheet1")
        LastRowcheck = .Range("A" & .Rows.Count).End(xlUp).Row
        For n1 = LastRowcheck To 3 Step -1
MsgBox (.Cells(n1, ChkCol).Value + " " + .Cells(n1 - 1, ChkCol).Value)
            If .Cells(n1, ChkCol).Value <> Cells(n1 - 1, ChkCol).Value Then
               .Rows(n1).Insert
               .Rows(n1 - 1).Select
                Selection.Copy
                Selection.Insert
'               .Rows(n1).Paste
            End If
        Next n1
    End With
End Sub

Reference Here2

Community
  • 1
  • 1
flywire
  • 1,155
  • 1
  • 14
  • 38

1 Answers1

0

Can be achieved without VBA, assuming h is in B3:

Select ColumnsA:B, DATA > Outline - Subtotal At each change in: 4, Use function: Count, Add subtotal to: tick j, tick Replace current subtotals, tick Summary below data, OK.

Filter ColumnsA:B, for ColumnA select Number Filters, Custom Filter..., contains, c, OK, Delete all visible below Row1, filter for (Select All), select ColumnsA:B, HOME > Editing - Find & Select, Go To Special..., select Blanks, OK.

=, Up, Ctrl+Enter. Remove Filter, select entire sheet, DATA > Outline - Ungroup, Clear Outline. Delete any surplus at the bottom.

pnuts
  • 58,317
  • 11
  • 87
  • 139