How to insert row above/below groups in a column using VBA

1
votes

I am having trouble even starting a macro for this. Any help would be greatly appreciated.

Referring to the example below, is it possible to find the first value of a group and insert a row above it. Such as: find the first "apple" in column A and insert row above, find the first "banana" in column A and insert row above, etc. It would also work to find the last value in a group and insert row below, such as: find the last "apple" in column A and insert row below.

Also needed is if there are no "apple"s in column A, move on to "banana"s. 

 	  A
1	apple
2	apple
3	apple
4	apple
5	banana
6	banana
7	banana
8	banana
9	banana
10	orange
11	orange
12	orange
13	orange
14	orange
15	orange
2
excelvba
I would put all the items inside an array and then loop through them all, using a Range variable to find the item for each loop and if it's found, insert the row. Pretty simple. - Damian
As per your example, I would loop through, set a string variable to the first item (add row) then match the cell values to the string, and when it returns different, insert a row and set the string to the new value. - Dean

2 Answers

1
votes

Here's a subroutine that should do what you're looking for. 

Sub main()
    Dim lastRow As Long
    Dim firstFruit As String

    With Sheets("Sheet1")
        'find last row containing a value
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        'initialize our first fruit as the first cell with a value.
        firstFruit = .Cells(1, 1).Value

        For ctr = 1 To lastRow
            If (.Cells(ctr, 1).Value <> firstFruit) Then 'we've found a new fruit
                .Rows(ctr & ":" & ctr).Insert 'insert our row above where we found it
                firstFruit = .Cells(ctr + 1, 1).Value 'set our fistFruit to equal the value of the new fruit
                lastRow = lastRow + 1 'add +1 to lastRow because we've added a new one
            End If
        Next ctr
    End With
End Sub
1
votes

Here is some code that will do what you want.

Sub LoopAddRow()

    Dim i As Long
    Dim sTemp As String
    Dim ws As Worksheet

    Set ws = Sheets("Sheet2")

    For i = 1 To 15
        If i = 1 Then
            sTemp = ws.Cells(i, 1).Value
            ws.Rows(i).EntireRow.Insert
        Else
            If ws.Cells(i, 1).Value <> sTemp Then
                sTemp = ws.Cells(i, 1).Value
                ws.Rows(i).EntireRow.Insert
            End If
        End If
    Next i

End Sub

Before & After below:

enter image description here

EDIT: Added lRow variable, per OP request

Sub LoopAddRow()

    Dim i As Long
    Dim sTemp As String
    Dim ws As Worksheet
    Dim lRow As Long

    Set ws = Sheets("Sheet2")
    lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

    For i = 15 To lRow
        If i = 1 Then
            sTemp = ws.Cells(i, 1).Value
            ws.Rows(i).EntireRow.Insert
        Else
            If ws.Cells(i, 1).Value <> sTemp Then
                sTemp = ws.Cells(i, 1).Value
                ws.Rows(i).EntireRow.Insert
            End If
        End If
    Next i

End Sub