Dim varTestVal4 As Variant
Dim intRowCount4 As Integer
Dim intAdjustment4 As Integer

ActiveSheet.Range("D1").Select
While Selection.Offset(1, 0).Value <> ""
    intRowCount4 = 1
    varTestVal4 = Selection.Value
    While Selection.Offset(1, 0).Value = varTestVal4
        intRowCount4 = intRowCount4 + 1
        Selection.Offset(1, 0).Select
        Selection.ClearContents
    Wend
    intAdjustment4 = (intRowCount4 * -1) + 1
    Selection.Offset(intAdjustment4, 0).Select
    Selection.Resize(intRowCount4, 1).Select
    With Selection
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Selection.Offset(1, 0).Resize(1, 1).Select

Wend