Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Help Please
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 *** |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Help Please
You don't need to loop,just specify more than one row like below. Not sure
which 3 rows you need to format. Once you find the Last Row in the code below you can make adjusrtments. 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 Application.ScreenUpdating = False Application.EnableEvents = False With Sheets("Position and Incumbent Data") LastRow = .Cells(.Rows.Count, "A").End(xlUp) .Cells(LastRow, "AT").End(xlUp).Copy _ Destination:=.Range(.Cells(LastRow + 1, "AT"), .Cells(LastRow + 3, "AT")) LastRow = LastRow + 3 .Cells(LastRow, "A").Name = "LastCell" Application.EnableEvents = True With .Rows((LastRow + 1) & ":" & (LastRow + 3)) .EntireRow.RowHeight = 102 End With With .Range("A" & (LastRow + 1) & ":AT" & (LastRow + 3)) .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Font .Name = "Arial" .FontStyle = "Regular" .Size = 8 End With .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .ShrinkToFit = False .MergeCells = False With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = xlAutomatic End With End With End With Sheets("Position and Incumbent Data").Select Range("LastCell").Offset(2, 0).Select Worksheets("Position and Incumbent Data").Cells(myR + 1, 1).Select End Sub "Chris" wrote: 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 *** |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Help Please
Thanks Joel for your help - greatly appreciated.
*** Sent via Developersdex http://www.developersdex.com *** |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping Help Please
Hi Don, thanks for you help - very much appreciated. I have sent you an
e-mail as requested. Many thanks, Chris. *** Sent via Developersdex http://www.developersdex.com *** |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
About my looping | Excel Programming | |||
Looping | Excel Programming | |||
Not Looping Through | Excel Programming | |||
Looping | Excel Programming | |||
Looping | Excel Programming |