Hello, could someone please have a look at the VBA code below and help
me so that it loops three-times. All the code needs to do is locate the
last cell in the worksheet and format three rows (no data in them).
There is a simple formula copied down in column AT.

It works well for one new row but it cannot find the next "LastCell" in
column A as it is empty.

Any help would be very much appreciated.

Kind regards,

Chris.


Sub Add_New_Record()

' Add New Record
'
'

Dim i As Integer
Dim myR As Long

On Error Resume Next

myR = Worksheets("Position and Incumbent Data").Cells(Rows.Count,
1).End(xlUp).Row

For i = 1 To 3


Application.ScreenUpdating = False

Application.EnableEvents = False

With Sheets("Position and Incumbent Data")

.Cells(.Rows.Count, "A").End(xlUp).Name = "LastCell"

.Cells(.Rows.Count, "AT").End(xlUp).Copy _
Destination:=.Cells(.Rows.Count, "AT") _
.End(xlUp).Offset(1, 0)

End With

Application.EnableEvents = True

Range("LastCell").Select

ActiveCell.Offset(1, 0).Range("A1").Select

ActiveCell.Rows("1:1").EntireRow.Select

Selection.RowHeight = 102

ActiveCell.Range("A1:AT1").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With

Sheets("Position and Incumbent Data").Select

Range("LastCell").Offset(2, 0).Select

Next i

Worksheets("Position and Incumbent Data").Cells(myR + 1, 1).Select

End Sub




*** Sent via Developersdex http://www.developersdex.com ***