Merge with Zero Data Loss

This macro is best called by assigning it to a short-cut key-sequence, e.g. "Ctrl-Shift-M"(erge).  Do this in the Macro Edit dialog by the Excel short-cut sequence Alt-T-M-M (See SWF video - will run in most browsers: IE, Chrome, Firefox). It calls "nibble" which has it's own Post, but is also included below.

Sub mergeselection()
 Dim strTemp As String
 Dim youAreHere As Object
 Dim cc, k As Integer
 
 Set youAreHere = ActiveCell
' MsgBox ActiveCell.Address
' MsgBox Selection.Rows.Count
 
 
 For Each cc In Selection.Cells
 strTemp = strTemp & vbCrLf & cc.Value
 'strTemp = strTemp & vbCrLf & k + 1 & " " & cc.Value
 'k = k + 1
 Next cc
 With Selection  'With Selection is left over from macro recording
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlBottom
 .WrapText = False
 .Orientation = 0
 .AddIndent = False
 .IndentLevel = 0
 .ShrinkToFit = False
 .ReadingOrder = xlContext
 ' .MergeCells = False
 End With
 Application.DisplayAlerts = False
 Selection.Merge
 Application.DisplayAlerts = True
 strTemp = nibble(strTemp) '& vbCrLf
 
 With youAreHere
 youAreHere.Value = strTemp
 youAreHere.HorizontalAlignment = xlLeft
 youAreHere.VerticalAlignment = xlTop
 youAreHere.Activate
 End With
 
End Sub

' ===========================
Private Function nibble(somestring)
 'Dim islf
 If Len(somestring) >= 1 Then
 While (Asc(Left(somestring, 1)) <= 13) 'this will eat vbTab chr(9) !!!
 ' islf = asc(right(somestring,1))
 somestring = Right(somestring, Len(somestring) - 1)
 Wend
 End If
 nibble = somestring
End Function

 

Leave a Reply

Your email address will not be published. Required fields are marked *