This site will look better if you upgrade to a browser that supports web standards.
As with the hard-coded version, this macro will merge the values in each row of the Selection, if no range is provided. However, it will also accept a range to merge , and a delimiter, as arguments.
If called from VBA, a delimiter string can be inserted between values by specifying it in the second argument.
Note, this Sub uses optional arguments to provide flexibility. That, however, prevents the macro from being listed in the macro list. You can still type the name of the macro in and click , or, you can create a wrapper that you can attach to a button, menu item or keyboard shortcut (see below).
'**************************************************************************
'Purpose: Merge values in a multi-column array into the first column
'Inputs: rRng (optional): the range to merge. If not provided, the Selection.
' sDelim (optional): A delimiter string to go between values.
'Returns: Merged values in column 1 of rRng
'**************************************************************************
Public Sub ColumnsToText(Optional rRng As Range, _
Optional sDelim As String = "")
'J.E. McGimpsey http://www.mcgimpsey.com/excel/mergedata1.html
Dim vTxtArr As Variant
Dim nTop As Long
Dim i As Long
Dim j As Integer
If rRng Is Nothing Then Set rRng = Selection
Set rRng = Intersect(rRng, rRng.Parent.UsedRange)
vTxtArr = rRng.Value
nTop = UBound(vTxtArr, 1)
For i = 1 To nTop
For j = 2 To UBound(vTxtArr, 2)
vTxtArr(i, 1) = vTxtArr(i, 1) & sDelim & vTxtArr(i, j)
Next j
Next i
ReDim Preserve vTxtArr(1 To nTop, 1 To 1)
rRng.Resize(, 1).Value = vTxtArr
End Sub
An example of a wrapper macro might be
Public Sub CTT_Button_Click()
ColumnsToText Selection, " "
End Sub
which you could place in your Personal Macro Workbook (Personal.xls for WinXL) and attach to a toolbar button to merge with spaces in between cell entries.
Again, like the hard-coded macro, this macro merges the entire Selection or other range you specify into one cell (and again, since there are optional arguments, it won't show up in your dialog, but you can still type the name MergeToOneCell in the textbox and click , or you can attach the macro to a toolbar button, menu item, or keyboard shortcut). If run from code, it can insert a delimiter between cells:
'**************************************************************************
'Purpose: Merge cells, retaining all data
'Inputs: rRng (optional): the range to merge. If not provided, the Selection.
sDelim (optional): A delimiter string to go between values.
'Returns: Merged values in the first cell of rRng
'**************************************************************************
Public Sub MergeToOneCell(Optional rRng As Range, _
Optional sDelim As String = "")
'J.E. McGimpsey, http://www.mcgimpsey.com/excel/mergedata1.html
Dim rCell As Range
Dim sMergeStr As String
If rRng Is Nothing Then Set rRng = Selection
With rRng
For Each rCell In .Cells
sMergeStr = sMergeStr & sDelim & rCell.Text
Next rCell
Application.DisplayAlerts = False
.Merge Across:=False
Application.DisplayAlerts = True
.Item(1).Value = Mid(sMergeStr, 1 + Len(sDelim))
End With
End Sub
As above, you could use a wrapper macro to merge the selected cells with a space or other delimiter.
This page last updated
© Copyright 2001 - 2004 McGimpsey and Associates. Except where noted, all code on this site may be distributed under the Gnu GPL. Acknowledgement is appreciated.
Unfamiliar with macros? Check out David McRitchie's Getting Started with Macros and User Defined Functions