Need to merge data per column if records in the first column are the same.

I wrote a VBA code and it works but it works very slow as it executes "merge" function per each row no matter if consequent cells are the same or different.

Sub DuplicateValues()

'Declare All Variables:

Dim myCell As Range
Dim myRow As Integer
Dim myRange As Range
Dim myCol As Integer
Dim i As Integer
Dim k As Integer

Dim myFirstRow As Long
Dim myFirstColumn As Long

Dim rngCopy As Range, rngPaste As Range

'Count Number of Rows and Columns:

Application.DisplayAlerts = False

myRow = Range(Cells(3, 1), Cells(3, 1).End(xlDown)).Count + 2 'first two rows are headers
myCol = Range(Cells(2, 1), Cells(2, 1).End(xlToRight)).Count

'Apply formatting to the end of the table:

With ActiveSheet
Set rngCopy = .Range(.Range("A3"), .Cells(myRow, myCol))

 With rngCopy.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlThin
    End With
End With

'Merge duplicated cells per Row:

myFirstRow = 3
myFirstColumn = 1

Set iRow = Cells(myFirstRow, myFirstColumn)
Set n = Cells(myFirstRow + 1, myFirstColumn)

For i = 1 To myRow

    If iRow <> n Then

                Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).HorizontalAlignment = xlCenter
                Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).VerticalAlignment = xlCenter
                Range(Cells(myFirstRow, 8), Cells(myFirstRow, 8)).WrapText = True
                Range(Cells(myFirstRow, 1), Cells(myFirstRow, myCol - 3)).EntireRow.AutoFit       

                iRow = Cells(myFirstRow + i, myFirstColumn)
                n = Cells(myFirstRow + i + 1, myFirstColumn)

                Else
                n = Cells(myFirstRow + i + 1, myFirstColumn)

                    For k = 1 To myCol - 3 'need to merge data per column but don't need to merge data in the last 3 columns

                        Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).Merge
                        Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).HorizontalAlignment = xlCenter
                        Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).VerticalAlignment = xlCenter
                        Range(Cells(myFirstRow + i - 1, 8), Cells(myFirstRow + i, 8)).WrapText = True
                        Range(Cells(myFirstRow + i - 1, k), Cells(myFirstRow + i, k)).EntireRow.AutoFit

                    Next

    End If
Next

End Sub

I tried to create a different logic to initiate "merge" by blocks (skip merging the same value cells in the first column right away):
merging only when the "base/initial" cell is not the same as a "check" cell and merge all appropriate cells all together (not by each row), but I can't find a way to make it work.

Would be very grateful for any code optimizations!