![]() |
Insert Rows with Border Formatting
Hi All I have a macro that inserts a blank row where it finds any text in column A (code below), is it possible to insert this line with a border on the top edge for columns A thru to J bearing in mind I have existing borders to the left and right that I do not want to impact upon (NB the left edge of column A and the right edge of column J are heavier weights than the other sides) Thaks in advance ksp Sub InsertRows() With Range("A10:A2499") On Error Resume Next Set C = .Find(What:="*", LookIn:=xlValues) If Not C Is Nothing Then firstaddress = C.Offset(1, 0).Address Do C.Offset(0, 0).EntireRow.Insert Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address < firstaddress End If End With End Sub -- ksp ------------------------------------------------------------------------ ksp's Profile: http://www.excelforum.com/member.php...fo&userid=6267 View this thread: http://www.excelforum.com/showthread...hreadid=537681 |
Insert Rows with Border Formatting
This puts a border on the top edge of the inserted row. If that isn't what
you want, then you should be able to adjust the macro. Test it on a copy of your data. Sub InsertRows() With Range("A10:A2499") On Error Resume Next Set c = .Find(What:="*", LookIn:=xlValues) If Not c Is Nothing Then firstaddress = c.Offset(1, 0).Address Do c.Offset(0, 0).EntireRow.Insert c.Offset(-1, 0).Resize(1, 10) _ .Borders(xlEdgeTop).Weight = xlMedium Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address < firstaddress End If End With End Sub -- Regards, Tom Ogilvy "ksp" wrote: Hi All I have a macro that inserts a blank row where it finds any text in column A (code below), is it possible to insert this line with a border on the top edge for columns A thru to J bearing in mind I have existing borders to the left and right that I do not want to impact upon (NB the left edge of column A and the right edge of column J are heavier weights than the other sides) Thaks in advance ksp Sub InsertRows() With Range("A10:A2499") On Error Resume Next Set C = .Find(What:="*", LookIn:=xlValues) If Not C Is Nothing Then firstaddress = C.Offset(1, 0).Address Do C.Offset(0, 0).EntireRow.Insert Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address < firstaddress End If End With End Sub -- ksp ------------------------------------------------------------------------ ksp's Profile: http://www.excelforum.com/member.php...fo&userid=6267 View this thread: http://www.excelforum.com/showthread...hreadid=537681 |
Insert Rows with Border Formatting
The following modification of your macro should do what you want. HTH
Otto Sub ksp() Dim C As Range Dim firstaddress As String On Error Resume Next Set C = Range("A10:A2499").Find(What:="*", LookIn:=xlValues) On Error GoTo 0 If Not C Is Nothing Then firstaddress = C.Offset(1, 0).Address Do C.EntireRow.Insert With C.Offset(-1).Resize(, 10).Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Set C = Range("A10:A2499").FindNext(C) Loop While Not C Is Nothing And C.Address < firstaddress End If End Sub "ksp" wrote in message ... Hi All I have a macro that inserts a blank row where it finds any text in column A (code below), is it possible to insert this line with a border on the top edge for columns A thru to J bearing in mind I have existing borders to the left and right that I do not want to impact upon (NB the left edge of column A and the right edge of column J are heavier weights than the other sides) Thaks in advance ksp Sub InsertRows() With Range("A10:A2499") On Error Resume Next Set C = .Find(What:="*", LookIn:=xlValues) If Not C Is Nothing Then firstaddress = C.Offset(1, 0).Address Do C.Offset(0, 0).EntireRow.Insert Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address < firstaddress End If End With End Sub -- ksp ------------------------------------------------------------------------ ksp's Profile: http://www.excelforum.com/member.php...fo&userid=6267 View this thread: http://www.excelforum.com/showthread...hreadid=537681 |
Insert Rows with Border Formatting
Thanks Guys it works a treat, now I can stop dreaming about this! Thanks again for your help - much appreciated KP -- ksp ------------------------------------------------------------------------ ksp's Profile: http://www.excelforum.com/member.php...fo&userid=6267 View this thread: http://www.excelforum.com/showthread...hreadid=537681 |
All times are GMT +1. The time now is 07:00 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com