Insert 5 rows between data change, copy one column & add text string to another

user_18894746 0
Viewed 47

I have no knowledge of VBA but I am wondering if I can get it to do something that I do manually.

I have some subject data. The columns are First Name, Surname, Staff, Sibling, Class, School, Admin. Usually there are multiple rows with the same data in the "Class" column. Each time the data in the "Class" column changes I need to insert 5 rows, copy the "class" from the cell above to these 5 rows and add the word "zzBLANK" to the surname column.

Some example data I use:
orig example data

The end result should be like this:
Result example data

Is this possible to do and could someone please help with the code? I managed to find some code which adds 5 rows between the data change in column E but I can not find how to add the data in to these rows. Or at least I don't have the understand to be able to take some other code and change it to my needs.

Sub DoubleRowAdder()

Dim i As Long, col As Long, lastRow As Long

col = 5
lastRow = Cells(Rows.Count, col).End(xlUp).Row

For i = lastRow To 2 Step -1
If Cells(i - 1, col) <> Cells(i, col) Then
Range(Cells(i, col).EntireRow, Cells(i + 4, col).EntireRow).Insert shift:=xlDown
End If
Next i

End Sub
vba excel
1 Answers

You just need to do it the same way you added rows just without EntireRow and the desired column only:

Option Explicit

Public Sub DoubleRowAdder()
    Const col As Long = 5
    Const AddRows As Long = 5
    
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, col).End(xlUp).Row
    
    Dim i As Long
    For i = lastRow To 2 Step -1
        If Cells(i - 1, col) <> Cells(i, col) Then
            'add rows
            Range(Cells(i, col).EntireRow, Cells(i + AddRows - 1, col).EntireRow).Insert shift:=xlDown
            
            'fill column 5 in those rows with value above
            Range(Cells(i, col), Cells(i + AddRows - 1, col)).Value = Cells(i - 1, col).Value
            
            'fill column 2 in those rows with zzBLANK
            Range(Cells(i, 2), Cells(i + AddRows - 1, 2)).Value = "zzBLANK"
        End If
    Next i
End Sub
user_32196130
Related