Formatting (Dynamic) - vba

Question

Hi All,
Please look into the above image where I have two tables. In first table with the below code I am getting that format.
But I would like to format like Table2 and number of rows in each merged cell is dynamic and it's not the same.
Is there a way to format like table2?
Range("B6:H" & LastRow2).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With

Answer 1

Simply Add this code to the end of your above code
For i = 6 To LastRow2
If Range("B" & i - 1).MergeCells = True And Range("B" & i).MergeCells = True And _
Range("B" & i - 1).MergeArea.Address = Range("B" & i).MergeArea.Address Then
Range("B" & i - 1 & ":H" & i).Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next i
So if I combine your code and my code then it will look like this
StartRow = 6 '<~~ For example
LastRow = 25 '<~~ For example
With Range("B" & StartRow & ":H" & LastRow)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End With
On Error Resume Next '<~~ Required if the StartRow = 1
For i = StartRow To LastRow
If Range("B" & i - 1).MergeCells = True And Range("B" & i).MergeCells = True And _
Range("B" & i - 1).MergeArea.Address = Range("B" & i).MergeArea.Address Then
Range("B" & i - 1 & ":H" & i).Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next i
On Error GoTo 0
Example

Answer 2

Here is the code to do this task. You need to pass the address of initial cell (this with text 'Column1') as the input parameter for this function, i.e. Call formatArray("A2").
First and last columns of your arrays are defined as constants FIRST_COL and LAST_COL and are currently set to 1 and 5 - if your arrays are located in other columns, just change the constant values.
Public Sub formatArray(startCell As String)
Const FIRST_COL As Integer = 1
Const LAST_COL As Integer = 5
'--------------------------------------------
Dim wks As Excel.Worksheet
Dim initialCell As Excel.Range
'--------------------------------------------
Dim region As Excel.Range
Dim firstRow As Long
Dim lastRow As Long
Dim row As Long
Dim rng As Excel.Range
Dim groups As New VBA.Collection
Dim groupStartRow As Long
'--------------------------------------------
Set wks = Excel.ActiveSheet
Set initialCell = wks.Range(startCell)
Set region = initialCell.CurrentRegion
firstRow = initialCell.row
lastRow = region.Cells(region.Cells.Count).row
'Divide range into groups. -----------------------------------------------------
For row = firstRow To lastRow
If Not IsEmpty(wks.Cells(row, FIRST_COL).value) Or row = lastRow Then
If groupStartRow Then
With wks
Set rng = .Range(.Cells(groupStartRow, FIRST_COL), _
.Cells(IIf(row = lastRow, row, row - 1), LAST_COL))
Call groups.Add(rng)
End With
End If
groupStartRow = row
End If
Next row
'-------------------------------------------------------------------------------
'At this point whole region is divided into smaller parts. Each part contains
'the rows that are merged in first column. Now we apply border formatting to
'each subregion separately.
For Each rng In groups
With rng
Call .BorderAround(xlContinuous, xlThick, 0, 0)
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 15
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 15
.Weight = xlThin
End With
End With
Next rng
End Sub