Inserting a Row

[Curtd]

Using VBA in a macro, I want to insert a new row everytime the data changes
in the rows of column A. Example
A1=Chevy
A2=Chevy
A3=Dodge
A4=Dodge.

A new row would be inserted between Chevy and Dodge when I run the macro.
Any help would be appreciate, thanks inadvance.

 

[Chip Pearson]

Here's some VBA code that will do what you want. It tests the values in
column A to see if a new row should be inserted. Note that it works its way
upwards in the sheet, starting at the last used cell in column A and move up
to row 1.

Sub AAA()
Dim LastRow As Long
Dim FirstRow As Long
Dim RowNdx As Long
Dim Temp As Variant

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
FirstRow = 1 'adjust as necessary
Temp = Cells(LastRow, "A").Value
For RowNdx = LastRow To FirstRow Step -1
If Cells(RowNdx, "A").Value <> Temp Then
Temp = Cells(RowNdx, "A").Value
Rows(RowNdx + 1).Insert
End If
Next RowNdx
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)d

 

[Mike H]

Hi,

Try this

Sub marine()
lastrowA = ActiveSheet.Range("A65536").End(xlUp).Row
For x = lastrowA To 2 Step -1
Cells(x, 1).Select
If Cells(x, 1).Value <> Cells(x - 1, 1).Value Then
Selection.EntireRow.Insert
End If
Next
End Sub

Mike

 

[Sandy Mann]

Try something like:

Sub InsertIt()
Dim LastRow As Long
Dim x As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = LastRow To 3 Step -1
If Cells(x, 1).Value <> Cells(x - 1, 1).Value Then
If Cells(x, 1).Value <> "" Then
Cells(x, 1).EntireRow.Insert shift:=xlDown
End If
End If
Next x

End Sub


--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

 

[Sandy Mann]

I thought that the line:

If Cells(x, 1).Value <> "" Then

would stop another blank row being inserted if the Macro is run for a second
time but it does not. Better to use soemthing like:

Sub InsertIt()
Dim LastRow As Long
Dim x As Long

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For x = LastRow To 3 Step -1
If Cells(x, 1).Value <> Cells(x - 1, 1).Value Then
If Cells(x, 1).Value <> "" Then
If Cells(x - 1, 1).Value <> "" Then
Cells(x, 1).EntireRow.Insert Shift:=xlDown
End If
End If
End If
Next x

Application.ScreenUpdating = True

End Sub


--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk