Need to add row based on column value

K

kfr

I need to add blank rows to a sheet as long as the text in column d is not
the same; I want those without a row between. I have used this macro to put
row in but don’t know where to add the additional coding to not put in the
additional row. Ex: what I want it to look like

(COL A) (COL B) (COL C) (COL D)
Test a Test b Test c Test d

Group a Group b Group c Group d
Group a Group b Group c Group d

My data a My data b My data c My data d

New info a New info b New info c New info d



Current Macro

Sub InsertBlankRow()
For r = Cells(Rows.Count, "E" <>).End(xlUp).Row To 2 Step -1
Rows(r).Insert Shift:=xlDown
Next r
end sub

Thanks
 
J

JLGWhiz

Give this a try.

Sub rwInst()
Dim lr As Long, sh As Worksheet
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, "D").End(xlUp).Row
For i = lr To 2 Step -1
If sh.Cells(i, "D") <> "" Then
If sh.Cells(i - 1, "D").Value <> "" And sh.Cells(i, "D").Value _
<> sh.Cells(i - 1, "D").Value Then
sh.Cells(i, "D").EntireRow.Insert
End If
End If
Next
End Sub
 
K

kfr

that worked- you da bomb

thanks much
--
kfr


JLGWhiz said:
Give this a try.

Sub rwInst()
Dim lr As Long, sh As Worksheet
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, "D").End(xlUp).Row
For i = lr To 2 Step -1
If sh.Cells(i, "D") <> "" Then
If sh.Cells(i - 1, "D").Value <> "" And sh.Cells(i, "D").Value _
<> sh.Cells(i - 1, "D").Value Then
sh.Cells(i, "D").EntireRow.Insert
End If
End If
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top