Merge and UnMerge cells - Excel VBA

Sub MergeTest()
Dim wsrng As Range
Set wsrng = ActiveSheet.UsedRange
Call MergeWS(wsrng)
'Call UnMergeWS(wsrng)
End Sub

Function MergeWS(WorkRng As Range)
Dim Rng As Range, xCell As Range
Dim xRows As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        With WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1))
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        i = j - 1
    Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function

Function UnMergeWS(WorkRng As Range)
Dim Rng As Range, xCell As Range
xTitleId = "KutoolsforExcel"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Rng In WorkRng
    If Rng.MergeCells Then
        With Rng.MergeArea
            .UnMerge
            .Formula = Rng.Formula
        End With
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function