VBA - insert a blank row over each new unique value in column S

[apwr]

Hi,

I want to insert a new line over each unique value in column S. The value in column S needs to be copied to column I. I also want to copy values from column A and B to the new line. See the example below:

It is important to keep the lines that not have a value in column S.

Thanks for your response.

 

[Snakehips]

@apwr Welcome to MrExcel.

Test this code and see if it helps.

Sub Add_Rows()
Dim r  As Long
Dim ur As Long
Dim srng As Range
Dim val As Variant

'last row of datain s
r = Range("S" & Rows.Count).End(xlUp).Row
'populated range in S
Set srng = Range("S1:S" & r)

Application.ScreenUpdating = False
Do While r > 1
val = Range("S" & r).Value
    If Not val = xlnullstring Then
    'get row of first instance of value in S
    mr = WorksheetFunction.Match(val, srng, 0)
    ' do stuff
      Range("S" & mr).Rows.EntireRow.Insert
      Range("I" & mr) = Range("S" & mr + 1)
      Range("A" & mr) = Range("A" & mr + 1)
      Range("B" & mr) = Range("B" & mr + 1)
      'adjust row
         r = mr
    End If
    'adjust for next row up
    r = r - 1
Loop

Application.ScreenUpdating = False
End Sub

 

[apwr]

Thank you! That worked flawlessy.