VBA and boarders

[Livin404]

Greetings, I'm trying to get borders around all cells containing data whilst ignoring cells that have no value. I tried using another VBA for another function then repurpose it, but had zero luck. The VBA I attempted to use is: Thank you,

Sub BlckOutlineCells()
    Dim wsAct As Worksheet
  
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  With Sheets("Inbound FIDS")
    .Activate
    With .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
  End With
  wsAct.Activate
  Application.ScreenUpdating = True
  End Sub

 

[Michael M]

Maybe this way

Sub BlckOutlineCells()
    Dim wsAct As Worksheet, cell As Range
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  Sheets("Inbound FIDS").Activate
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell <> "" Then
        With cell.Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
Next cell
wsAct.Activate
  Application.ScreenUpdating = True
  End Sub

 

[Livin404]

In this question I meant to ask to have those borders put around Cells that have a filled color. I have a VBA before this one where I have a VBA for conditional formatting as seen below.

Sub Format_FID_ROWS()
Dim i, Count As Long
Dim wsAct As Worksheet
  
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  With Sheets("Inbound FIDS")
    .Activate
i = 1
Count = Sheets("Inbound FIDS").Cells(Rows.Count, "A").End(xlUp).Row

Do While i <= Count

Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(34, 34, 147)
i = i + 1

If i > Count Then
Exit Do
End If
Range(Cells(i, 1), Cells(i, 3)).Interior.Color = RGB(45, 45, 185)
i = i + 1

Loop
End With
wsAct.Activate
  Application.ScreenUpdating = True
End Sub

 

[Livin404]

Disregard my message regarding borders around fill color.

 

[Livin404]

Maybe this way

Sub BlckOutlineCells()
    Dim wsAct As Worksheet, cell As Range
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  Sheets("Inbound FIDS").Activate
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell <> "" Then
        With cell.Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
Next cell
wsAct.Activate
  Application.ScreenUpdating = True
  End Sub

That is great, I meant it to apply to Columns B & C. I'm sure it's an easy fix. Thank you so much!

 

[Michael M]

Try this

Sub BlckOutlineCells()
    Dim wsAct As Worksheet, cell As Range
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  Sheets("Inbound FIDS").Activate
    For Each cell In Range("B1:C" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell <> "" Then
        With cell.Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
Next cell
wsAct.Activate
  Application.ScreenUpdating = True
  End Sub

 

[Livin404]

That is great, I put in the letter C, so it covers A through C. One thing though which I didn't think about. In Column C is the Remarks Column which doesn't always have content in the cell. If a row in Column A has data, can I get the borders for Columns B and C too on those rows? I 'm so sorry. I was really thinking if a row does not have any data in any columns I didn't want the boarder. I didn't realize my question was understated until after the 15 minutes to edit had come and passed.

 

[Michael M]

Does this do the job

Sub BlckOutlineCells()
    Dim wsAct As Worksheet, cell As Range
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  Sheets("Inbound FIDS").Activate
    For Each cell In Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell <> "" Then
        With cell.Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
Next cell
wsAct.Activate
  Application.ScreenUpdating = True
  End Sub

 

[Michael M]

Untested

Sub MM1()
    Dim wsAct As Worksheet, cell As Range, lr As Long, r As Long
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  Sheets("Inbound FIDS").Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
        If Cells(r, 1) <> "" Then
        With Range(Cells(r, 1), Cells(r, 3)).Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
Next r
For Each cell In Range("B1:C" & Cells(Rows.Count, "A").End(xlUp).Row)
        If cell <> "" Then
        With cell.Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
Next cell
wsAct.Activate
  Application.ScreenUpdating = True
  End Sub

 

[Michael M]

Still not certain if this what you are after......and still UNTESTED

Sub MM1()
    Dim wsAct As Worksheet, cell As Range, lr As Long, r As Long
  Set wsAct = ActiveSheet
  Application.ScreenUpdating = False
  Sheets("Inbound FIDS").Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
        If Cells(r, 1) <> "" Then
        With Range(Cells(r, 1), Cells(r, 3)).Borders
        .LineStyle = xlContinuous
        .Color = 1
        .Weight = xlMedium
    End With
    End If
        If Cells(r, 2) <> "" Then
                With Cells(r, 2).Borders
                .LineStyle = xlContinuous
                .Color = 1
                .Weight = xlMedium
            End With
            End If
        If Cells(r, 3) <> "" Then
                With Cells(r, 3).Borders
                .LineStyle = xlContinuous
                .Color = 1
                .Weight = xlMedium
            End With
            End If
Next r
  Application.ScreenUpdating = True
  End Sub