ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Insert row at change macro - how to change it. (https://www.excelbanter.com/excel-discussion-misc-queries/225648-insert-row-change-macro-how-change.html)

cathit

Insert row at change macro - how to change it.
 
Some on this board wrote a macro for me to insert a blank row after a column
of names and it works wonderfully for last names. However if doesn't put a
blank row between people with the same last name, but different first names.
Is it possible for someone to look at this macro and change it for me?
Thanks, I'll be very grateful.

'Sandy Mann July 1st, 2007
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


Sheeloo[_4_]

Insert row at change macro - how to change it.
 
Looks like your last names are in Col A...
If first names are in Col B then use this
(just changed 1 i.e. Col A to 2 i.e. Col B)
It is assumed that data is sorted on Last name and then on first name...

Sub insertRow()
Dim LastRow As Long
Dim X As Long
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False

For X = LastRow To 3 Step -1
If Cells(X, 2).Value < Cells(X - 1, 2).Value Then
If Cells(X, 2).Value < "" Then
If Cells(X - 1, 2).Value < "" Then
Cells(X, 2).EntireRow.Insert Shift:=xlDown
End If
End If
End If
Next X
Application.ScreenUpdating = True


End Sub
"cathit" wrote:

Some on this board wrote a macro for me to insert a blank row after a column
of names and it works wonderfully for last names. However if doesn't put a
blank row between people with the same last name, but different first names.
Is it possible for someone to look at this macro and change it for me?
Thanks, I'll be very grateful.

'Sandy Mann July 1st, 2007
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



All times are GMT +1. The time now is 01:23 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com