Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Select Case True
Case IsNull(Target.MergeCells)
Case Not Target.Rows.Count = 3
Case Not Target.Columns.Count = 1
Case Not Target.Cells(1) = ""
Case Else
Set R = Columns(Target.Column).Find("*", Target.Cells(1), xlValues, xlWhole, xlByColumns, xlPrevious)
If Not R Is Nothing Then
If R.Row < Target.Row Then
Target = R
R.MergeArea = ""
End If
End If
End Select
End Sub