Bottom Lines

[adamsm]

The following code inserts bottom lines from row 6 onwards depending upon data in column C.

<dl class="codebox"><dd><code>Sub InsertBottomLine()
Dim LastRow As Long
Dim I As Integer
    Application.ScreenUpdating = False
    LastRow = Range("C" & Rows.Count).End(xlUp).Row
    For I = 16 To LastRow
        If Cells(I, 3) <> Empty Then Cells(I, 3).Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Next I
    Application.ScreenUpdating = True
End Sub</code></dd></dl>

How could I make the code so that it inserts bottom lines from column C to column J if data consists in column F.

 

[AlphaFrog]

Sub InsertBottomLine()
Dim LastRow As Long
Dim I As Integer
    Application.ScreenUpdating = False
    LastRow = Range([COLOR="Red"]"F"[/COLOR] & Rows.Count).End(xlUp).Row
    For I = 16 To LastRow
        If Cells(I, [COLOR="Red"]"F"[/COLOR]) <> [COLOR="Red"]""[/COLOR] Then Cells(I, 3).Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Next I
    Application.ScreenUpdating = True
End Sub

 

[adamsm]

Thanks for the help. But your code only inserts bottom lines where data contains in column F but not in column C.

How could I overcome this?

 

[AlphaFrog]

Sub InsertBottomLine()
Dim LastRow As Long
Dim I As Integer
    Application.ScreenUpdating = False
    LastRow = Range("C:F").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    For I = 16 To LastRow
        If Cells(I, "C") <> "" Or Cells(I, "F") <> "" Then Cells(I, 3).Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Next I
    Application.ScreenUpdating = True
End Sub

 

[adamsm]

Thanks for the help. The code now does what had been requested. How could the code be further enhanced so that it does not insert bottom lines if data only consits in column C. Meaning if column C has data and if column F has no data the code would not insert any line.

Any help on this would be kindly appreciated.

 

[AlphaFrog]

If Cells(I, "C") <> "" [COLOR="Red"]And[/COLOR] Cells(I, "F") <> "" Then

 

[adamsm]

Thanks for the reply. But with the modification the code does not seem to inert any lines. What may be the reason for this?

Here's the final code.

Sub InsertBottomLine()
Dim LastRow As Long
Dim I As Integer
    Application.ScreenUpdating = False
    LastRow = Range("C:F").Find("*", , xlValues, , xlByRows, xlPrevious).Row
    For I = 16 To LastRow
        If Cells(I, "C") <> "" And Cells(I, "F") <> "" Then Cells(I, 3).Resize(1, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Next I
    Application.ScreenUpdating = True
End Sub

Any help on this would be kindly appreciated.