VBA code to insert rows in table

[Guest]

I have a table (list) of property addresses sorted by location, which is the
left-most column in the table. Sometimes, locations happen to be rather long.
To save space on the printed copy, I would like to set the locations column
out of the print range, and, in order to break the table according to
locations, insert a new table row just above any row which starts a new
location.
I'm in need for good VBA code which will 1) scan the Locations column, top
to bottom, for a change in location, and when such a change is detected 2)
insert a new table row just above that row 3) Copy the new location text and
4) paste it one row above and one column to the right from the copied cell.
Could any one please help me with this code?

 

[Bob Phillips]

Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If .Cells(i, "A").Value <> .Cells(i - 1, "A") Then
.Rows(i).Insert
.Cells(i, "B").Value = .Cells(i + 1, "A").Value
End If
Next i
.Rows(1).Insert
.Cells(1, "B").Value = .Cells(2, "A").Value

End With

End Sub


--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Guest]

try this

Sub moveaddr()

Const AddressCol = "A"

RowCount = 1
Do While Not IsEmpty(Cells(RowCount + 1, AddressCol))

If Cells(RowCount, AddressCol) <> _
Cells(RowCount + 1, AddressCol) Then

Cells(RowCount + 1, AddressCol).EntireRow.Insert
RowCount = RowCount + 1
Cells(RowCount, AddressCol).Offset(0, 1) = _
Cells(RowCount + 1, AddressCol)
End If

RowCount = RowCount + 1
Loop

End Sub

 

[Guest]

Many thanks to you, Joel.
I've edited the code to reflect my actual situation and to add some nice
formatting, it printes beautifully.
Here is the code: (Maybe some redundancies, I'm not experienced, yet)

Sub breakBorough()

Const AddressCol = "b"

RowCount = 4
Do While Not IsEmpty(Cells(RowCount + 1, AddressCol))

If Cells(RowCount, AddressCol) <> _
Cells(RowCount + 1, AddressCol) Then

Cells(RowCount + 1, AddressCol).EntireRow.Insert
RowCount = RowCount + 1
Cells(RowCount + 1, AddressCol).Select
Selection.Copy
ActiveCell.Offset(-1, 0).Range("A1:O1").Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Font
.Name = "Calibri"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
ActiveCell.Offset(-1, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False



End If

RowCount = RowCount + 1
Loop

End Sub