Add a Row dependent on whether two cells have equal values

[James__FinR]

Hi All,

Bit new to VBA, only really using it to make a repetitive task of mine at work much easier!

I have a spreadsheet of raw data that I need to separate so that it is easier to read. Essentially looking to input a function where if value A6 does not equal A5, insert a row between A6 and A5.
e.g.

From:

Apple
Apple
Banana
Banana
Lemon
Cranberry

To:

Apple
Apple

Banana
Banana

Lemon

Cranberry

Hope this isn't too vague. Do ask my questions, though please note I'm quite the amateur.

Appreciate the help!

 

[Fluff]

How about

Sub James_FinR()
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
      If Cells(i, 1) <> Cells(i - 1, 1) Then Rows(i).Insert
   Next i
End Sub

 

[steve the fish]

Way id do this:

With Sheets("Sheet1")
    frow = 2 'first row of data exc. headers
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    If lrow > frow Then
        For i = lrow To frow + 1 Step -1
            If .Cells(i, 1) <> .Cells(i - 1, 1) And .Cells(i, 1) <> "" And .Cells(i - 1, 1) <> "" Then
                .Rows(i).Insert
            End If
        Next
    End If
End With

 

[James__FinR]

Thanks for the help! Much appreciated.
So the data I'm looking to separate is in column D, I've made edits as below. Though it seems to only be separating column A. Apologies for not specifying this earlier!

  With Sheets("Realtime Positions")
    frow = 6 'first row of data exc. headers
    lrow = .Range("D" & .Rows.Count).End(xlUp).Row
    If lrow > frow Then
        For i = lrow To frow + 1 Step -1
            If .Cells(i, 1) <> .Cells(i - 1, 1) And .Cells(i, 1) <> "" And .Cells(i - 1, 1) <> "" Then
                .Rows(i).Insert
            End If
        Next
    End If
End With

 

[Fluff]

You need to change the column component of Cells from 1 to 4

 

[James__FinR]

Thanks Fluff. Made further edits (Very amateur at this, apologies if I've missed something) but I'm now getting lines between all rows, as opposed to grouping those of the same.

Let me know if I've missed something on the below:

With Sheets("Realtime Positions")
frow = 6 'first row of data exc. headers
lrow = .Range("D" & .Rows.Count).End(xlUp).Row
If lrow > frow Then
For i = lrow To frow + 1 Step -1
If .Cells(i, 4) <> .Cells(i - 1, 1) And .Cells(i, 4) <> "" And .Cells(i - 1, 1) <> "" Then
.Rows(i).Insert
End If
Next
End If
End With

 

[Fluff]

You need to change the column component of all the cells, not just two of them.

 

[James__FinR]

Great stuff, thanks Fluff. All working now.

 

[Fluff]

Glad we could help & thanks for the feedback.