Insert Line

[adamsm]

Hi anyone,

The following code inserts continuous lines to the bottom of row 16 & thin lines to the bottom of the row 18 from columns C to J.

Sub InsertLine()
Range("C16:J16").Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("C18:C18").Borders(xlEdgeBottom).LineStyle = xlThin
End Sub

How could I modify the code so that it inserts a continous line to the bottom of any row where it contains bold text in column C and the remaining rows a thin line starting from column C to column J.

Any help on this would be kindly appreciated.

Thanks in advance.

 

[PCL]

Using your code see next macro.
Adapt the range (starting = 1???) to your need.

Option Explicit
Sub PrepareFormat()
Dim LastRow As Long
Dim WkRg As Range
Dim F As Range
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    Set WkRg = Range("C1:C" & LastRow)
    For Each F In WkRg
        If ((F.Font.FontStyle = "Bold") Or (F.Font.FontStyle = "Bold Italic")) Then
            F.Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
        Else
            F.Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlThin
        End If
    Next F
End Sub

 

[adamsm]

Thanks for the help. How could I limit the code not to insert lines at the bottom of empty rows within the data rows.

And also not to insert a continuous line to a row where data does not contain in column E even if the remaining columns contain Bold text.

Instead to insert a thin line.

Any help on this would be kindly appreciated.

 

[PCL]

See next code
As only column C is checked for bold font, the complete range from C to J is checked for empty row.

Option Explicit
Sub PrepareFormat()
Dim LastRow As Long
Dim WkRg As Range
Dim F As Range
Dim I As Integer
Dim TestRow
    Application.ScreenUpdating = False
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    Set WkRg = Range("C2:C" & LastRow)
    For Each F In WkRg
        If ((F.Font.FontStyle = "Bold") Or (F.Font.FontStyle = "Bold Italic")) Then
            If (F.Offset(0, 2) <> Empty) Then F.Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
        Else
            TestRow = Empty
            For I = 0 To 7
                TestRow = TestRow & F.Offset(0, I)
            Next I
           If (TestRow <> Empty) Then F.Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlThin
        End If
    Next F
    Application.ScreenUpdating = True
End Sub

 

[adamsm]

Thanks for the help once again. If I could ask for one more help. How could he first code you've written in this thread be changed so that inserts continuous lines onto cell bottom whether the text is bold or not leaving the empty rows.

Any help this would be kindly appreciated.

 

[PCL]

Is that means there is no anymore some THIN border

 

[adamsm]

Yeah only the continuous border with Grey color.

 

[PCL]

Try and double check

Option Explicit
Sub PrepareFormat()
Dim LastRow As Long
Dim WkRg As Range
Dim F As Range
Dim I As Integer, J As Integer
Dim TestRow
    Application.ScreenUpdating = False
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    For I = 2 To LastRow
    Set WkRg = Range("C2:C" & LastRow)
    TestRow = Empty
        For J = 0 To 8
            TestRow = TestRow & Cells(I, 3 + J)
        Next J
        If ((Cells(I, 3) <> Empty) And (TestRow <> Empty)) Then Cells(I, 3).Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Next I
    Application.ScreenUpdating = True
End Sub

 

[adamsm]

Sorry for the late response, But thanks for the help & I do really appreciate it.