Inserting a row when the value of a field changes

Solved/Closed
kkautz Posts 1 Registration date Friday April 25, 2014 Status Member Last seen April 25, 2014 - Apr 25, 2014 at 03:06 PM
 KKautz - Apr 28, 2014 at 09:51 AM
I was using this code as a start but can't seem to mak it do exactly what I want.

Sub InsertRows()
Dim r As Long, mcol As String, i As Long

' find last used cell in Column A
r = Cells(Rows.Count, "A").End(xlUp).Row

' get value of last used cell in column A
mcol = Cells(r, 1).Value

' insert rows by looping from bottom
For i = r To 2 Step -1
If Cells(i, 1).Value <> mcol Then
mcol = Cells(i, 1).Value
Rows(i + 1).Insert
End If
Next i

End Sub

Here is my code.
I am inserting a row after the value in volumn B changes. It is not inserting the first break when thevalue changes starting from the bottom.
I also do not want to insert a row after my column headings. HELP!

Sub InsertRows()
Dim r As Long, mcol As String, i As Long

Sheets("Sheet1").Select

' find last used cell in Column B
r = Cells(Rows.Count, "B").End(xlUp).Row

' get value of last used cell in column A
mcol = Cells(r, 2).Value

' insert rows by looping from bottom
For i = r To 2 Step -1
If Cells(i, 1).Value <> mcol Then
mcol = Cells(i, 1).Value
Rows(i + 1).Insert
Rows("2:2").Select
Selection.Copy
End If
Next i

End Sub

1 reply

venkat1926 Posts 1864 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 810
Apr 26, 2014 at 07:55 AM
data is like this

hdng1
a
a
a
d
d
d
d
d
d
f



will this macro help
Sub test()
Dim j As Integer, k As Integer

j = Range("A1").End(xlDown).Row
For k = j To 3 Step -1
If Cells(k, 1) <> Cells(k - 1, 1) Then Cells(k, 1).EntireRow.Insert
Next k

End Sub
0
Thank you. I ended up doing the following and it seems to work.

'Insert a new row if the values in either column A or B changes
'Copy the heading to the inserted row
Dim LR As Long, i As Long
LR = Range("B" & Rows.Count).End(xlUp).Row

For i = LR To 5 Step -1
If Range("A" & i).Value <> Range("A" & i - 1).Value Or Range("B" & i).Value <> Range("B" & i - 1).Value Then Rows(i).Insert
Rows("2:2").Select
Selection.Copy
Next i
Range("A1").Select
MsgBox "Done"
0