Excel udf: Combine cell ranges into a single range while eliminating blanks
Filed in Combine/Merge, Excel, User defined functions (udf), vba on Apr.21, 2011. Email This article to a Friend
This is a question from Shawna.
Userdefined function in cell range B3:B70, entered as an array formula:
=MergeRanges(D2:D30, F2:F30, Sheet2!C1:C35)
How to create an array formula
- Select cell range B3:B70.
- Copy (Ctrl + c) and paste (Ctrl + v) array formula into formula bar.
- Press and hold Ctrl + Shift.
- Press Enter once.
- Release all keys.
VBA:
Function MergeRanges(ParamArray arguments() As Variant) As Variant()
Dim cell As Range, temp() As Variant, argument As Variant
Dim iRows As Integer, i As Integer
ReDim temp(0)
For Each argument In arguments
For Each cell In argument
If cell <> "" Then
temp(UBound(temp)) = cell
ReDim Preserve temp(UBound(temp) + 1)
End If
Next cell
Next argument
ReDim Preserve temp(UBound(temp) - 1)
iRows = Range(Application.Caller.Address).Rows.Count
For i = UBound(temp) To iRows
ReDim Preserve temp(UBound(temp) + 1)
temp(UBound(temp)) = ""
Next i
MergeRanges = Application.Transpose(temp)
End FunctionHow to use user defined function in excel
- Press Alt-F11 to open visual basic editor
- Click Module on the Insert menu
- Copy and paste vba code
- Exit visual basic editor
Download excel example file
Combine ranges.xls
(Excel 97-2003 Workbook *.xls)
Related posts:
Excel udf: Filter unique distinct values (case sensitive)
User defined function to split words in a cell range into a cell each in excel
Adjust stock chart axis automatically
Excel udf: Filter values existing only in one out of two ranges
Recommended categories
Redim Preserve does not execute all that quickly, so it is usually a good idea to avoid using it too often. Here is an alternate function to the one you posted which avoids them altogether...
Function MergeRanges(ParamArray Arguments() As Variant) As Variant() Dim X As Long, Index As Long, Cell As Variant, TempArray As Variant, Done As Boolean ReDim TempArray(1 To Application.Caller.Count) Index = 1 For X = LBound(Arguments) To UBound(Arguments) For Each Cell In Arguments(X) If Len(Cell.Value) Then TempArray(Index) = Cell.Value Index = Index + 1 If Index > UBound(TempArray) - LBound(TempArray) + 1 Then Done = True Exit For End If End If Next If Done Then Exit For Next For X = Index To UBound(TempArray) TempArray(X) = "" Next MergeRanges = Application.Transpose(TempArray) End FunctionRick Rothstein (MVP - Excel),
I didn´t know! I am curious, I have to do some speed tests.
Thank you for your valuable contribution!