PDA

View Full Version : Add row if text is not identical to above cell



nihi
07-27-2015, 01:00 PM
Hello, I´m trying to write a macro that checks the content of cells, and if it is not equal to the cell above it insert an empty row.
However I am having some trouble figuring out how to loop correctly:

Sub Zwischensumme()

Cells(9, 4).Select
For i = 0 To 40

ActiveCell.Offset(i, 0).Select

If ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value Then
Rows(ActiveCell.Row).Select
Selection.Insert Shift:=xlDown
Cells(9, 4).Select

End If


Next i


End Sub



This works at the beginning, however it eventually skips cells (obviously, as i becomes so large that it offsets a lot of cells at once). I feel like there is an obvious solution to this, but i cannot see it ....

Another issue is that once it enters an empty row, it considers that as different to the cell below, and therefore inserts another empty row, etc. I would like to avoid that as well.


I only started using VBA very recently, so it is quite possible (and likely) that there is a much better/ easier way to do this.

Thank you for your help!

NoSparks
07-27-2015, 09:15 PM
Work from the bottom up

For i = 40 to 0 step -1

ashleyuk1984
07-28-2015, 10:01 AM
Yeah that's right, when inserting rows you'll want to be working from the bottom upwards. As this will cause you less errors.

Something like this will be suffiencent.


Sub Zwischensumme()

For i = 50 To 1 Step -1
If Range("D" & i).Value <> Range("D" & i - 1).Value Then Rows(i).EntireRow.Insert Shift:=xlDown
Next i

End Sub

Edit the code to meet your requirements, but it will be looking at column D, by looking at your code you posted, it looked like this was the criteria you were testing for.

You'll end up with a result like this.

http://i.imgur.com/eBPt04N.png