C
Chris
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
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