Formatting (Dynamic)

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