Cell Borders in VBA

[Enzo_Matrix]

    ActiveSheet.Range("A5:I50").Select
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With

My range of data changes as I add or remove information from my table.

Is there a way to modify this or add a few lines so that only the cells that have information in them are underlined?

IF cell "" Then ""?

 

[jproffer]

Maybe this:

Sub test()
Dim cell As Range
Dim myRange As Range

Set myRange = Range("A5:I50")

For Each cell In myRange
    If cell.Value <> "" Then
        With cell.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End If
Next cell

End Sub

Selecting is almost never necessary. The recorder loves to Range(xxxxx).Select and then Selection. (do something) on the next line.

Any time you see that, you can combine the 2 lines like Range(xxxxx).(do something)

 

[Mississippi Girl]

Maybe?

if cell.value >"" then

 

[mole999]

if you utilise LastRow code then you could

Range("A5:I"& LastRow)

 

[Enzo_Matrix]

I think that is the best way as sometime there are 10 lines of data and sometimes up to 100.

Could you show my how to incorporate that '& LastRow' function into the initial code I wrote?

 

[Rick Rothstein]

Does this do what you want...

[table="width: 500"]
[tr]
	[td]Sub UnderlineDataCells()
  With Range("A5:I50").SpecialCells(xlConstants).Borders(xlBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
  End With
End Sub[/td]
[/tr]
[/table]

 

[Enzo_Matrix]

That is exactly what I was hoping for.

Is there a way to modify the range so that it automatically stops at the bottom row?

 

[Enzo_Matrix]

nvm, I saw that that does do exactly what I needed.

Thank you!

 

[Enzo_Matrix]

You very kindly provided this code for me a few months back and a bug has started cropping up in my sheets.
For some reason there are blank rows that are underlined and I cannot figure out why.

This is the code I think might be causing the issue.

Sub FilterCopy()   
   Dim Ary As Variant
   Dim i As Long
   Dim Sht As Variant
     
   Ary = Array("Weld", "Composite", "Rubber", "Repairs")
   For Each Sht In Ary
      Sheets(Sht).UsedRange.ClearContents
   Next Sht
   With Sheets("Data")
      If .AutoFilterMode Then .AutoFilterMode = False
      For i = 0 To UBound(Ary)
         .Range("A4").AutoFilter 1, Ary(i)
         On Error Resume Next
         .UsedRange.Offset(1).SpecialCells(xlVisible).Copy Sheets(Ary(i)).Range("A" & Rows.Count).End(xlUp).Offset(4)
         On Error GoTo 0
      Next i
      .AutoFilterMode = False
   End With
    
End Sub

Here is a portion of my main code where the underlining is segmented in.

' Color formatting of cells based on date range    With Sheets("Composite")
        For Each cell In Range("G5:G" & LR)
            myrow = cell.Row
            If cell <= Date Then
                Range(Cells(myrow, "A"), Cells(myrow, "G")).Interior.Color = RGB(217, 217, 217)
            End If
        Next cell
    End With
        
'Underlining cells based on date range
    With Range("A5:I50").SpecialCells(xlConstants).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
'inserting a blank line at the end of each week
For i = LR To 5 Step -1
    If Cells(i, Col).Value >= Date Then
        On Error Resume Next
            If Cells(i, Col).Value - Cells(i - 1, Col).Value > 1 Then
                On Error GoTo 0
                Cells(i, Col).EntireRow.Insert
            End If
    End If
Next i

If you have a chance, please take a look and let me know if there is something I can do to fix the problem.