Add borders to current and adjacent cell in a given range - excel

Question

I have a range of data which has a combination of merged/unmerged, empty/non empty cells. I currently have the code which skips the empty cells in a given range and adds border to non-empty cells. Here is the code which I wrote.
Set iRange = ea.Range(Cells(2, 1), Cells(EAlastrow, EAlastcol))
For Each iCells In iRange
If iCells.MergeCells Then
If Not IsEmpty(iCells) Then
Dim iCellRange As String
iCellRange = iCells.MergeArea.Address
Range(iCellRange).BorderAround xlContinuous, xlThin
End If
Else
If Not IsEmpty(iCells) Then
iCells.BorderAround xlContinuous, xlThin
End If
End If
Next iCells
Is it possible to set the range in a way that it includes below empty cells too and add a border to it?
This is how the table is structured:
Thanks in advance.

Answer 1

Try this:
Sub SubFormat()
'Declarations.
Dim RngHeader As Range
Dim RngTarget As Range
Dim DblLastRow As Double
Dim DblMaxLastRow As Double
'Setting RngHeader as the first line of the data i want to be formatted.
Set RngHeader = Range("A2:AB2")
'Checking which is the highest value of non empty row for each column of RngHeader.
For Each RngTarget In RngHeader
DblLastRow = Cells(Cells.Rows.Count, RngTarget.Column).End(xlUp).Row
DblMaxLastRow = Excel.WorksheetFunction.Max(DblMaxLastRow, DblLastRow)
Next
'If no data has been found, the macro is terminated.
If DblMaxLastRow < RngHeader.Row Or _
(DblMaxLastRow = RngHeader.Row And Excel.WorksheetFunction.CountBlank(RngHeader) = RngHeader.Cells.Count) _
Then
MsgBox "No data found", vbCritical + vbOKOnly, "No data found"
Exit Sub
End If
'Targeting the data.
With Range(RngHeader.Cells(1, 1), Cells(DblMaxLastRow, RngHeader.Cells(1, RngHeader.Columns.Count).Column))
'Setting the borders' format.
.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub

Answer 2

You can get the last cell with data for each column and then set border for each cell in that column till the last cell with data. In below code 3 indicates column C
lastRow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Row
Range("C1:C" + CStr(lastRow)).Borders.LineStyle = xlContinuous

Answer 3

You can try this it works fine for me:
Sub ALLBorders()
With Cells.SpecialCells(xlCellTypeConstants, 23)
.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub
Here is the second requirement solution.
Sub BorderMultiRange()
With Sheets("Sheet1").Range("A28:A29,C5:E9,G11:J14")
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End Sub