Link to home
Create AccountLog in
Avatar of mlagrange
mlagrangeFlag for United States of America

asked on

Combine multiple ranges into a single range?

Hello - I have a worksheet that has 3 separate (but identically laid-out) input sections, that I set up as named ranges. I would like to merge the ranges into a single range on a separate worksheet, to make it easier to import into an Access database.

I thought about looping through the rows of each source range and writing to the destination range using .EntireRow.Insert and .Copy, but is there a more direct way?

Thanks
Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image

This code assumes you have three named ranges, "First", "Second" and "Third", and an output named ranged called.... "Output".

It will copy the three ranges one after the other, starting at the Output range:
Public Sub CombineRanges()

    Dim rngSource As Range
    
    Dim rngOut As Range
    
    Set rngOut = Application.Range("Output").Cells(1)
    
    Set rngSource = Application.Range("First")
    Set rngOut = rngOut.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
    rngOut.Value = rngSource.Value
    ' move the output range on to the end of the filled area
    Set rngOut = rngOut.Offset(rngOut.Rows.Count, 0)
    
    Set rngSource = Application.Range("Second")
    Set rngOut = rngOut.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
    rngOut.Value = rngSource.Value
    ' move the output range on to the end of the filled area
    Set rngOut = rngOut.Offset(rngOut.Rows.Count, 0)
    
    Set rngSource = Application.Range("Third")
    Set rngOut = rngOut.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
    rngOut.Value = rngSource.Value
    

End Sub

Open in new window

Try this code, replacing sheet names and ranges to named ranges:

Dim coll As Collection

Sub main()
Set coll = New Collection
Dim r As Range
Set r = Sheets("Sheet1").Range("A1:A10")
Call Builder(r)
Set r = Sheets("Sheet2").Range("B1:B10")
Call Builder(r)
Set r = Sheets("Sheet3").Range("C1:C10")
Call Builder(r)
Set r = Sheets("Sheet1").Range("B1")
Call Displayer(r)
Set coll = Nothing
End Sub

Sub Builder(r As Range)
Dim arr
arr = r
On Error Resume Next
For i = 1 To UBound(arr)
coll.Add arr(i, 1), CStr(arr(i, 1))
Next i
End Sub

Sub Displayer(r As Range)
MsgBox coll.Count
For i = 1 To coll.Count
r.Value = coll.Item(i)
Set r = r.Offset(1, 0)
Next
End Sub


PC Review Forums
You could generalise the routine by having it accept an array of input range names:
Public Sub Test()

    Call CombineRanges(Array("First", "Second", "Third"), "Output")

End Sub

Public Sub CombineRanges(ByVal vInputRanges As Variant, ByVal strOutput As String)

    Dim rngSource As Range
    
    Dim rngOut As Range
    Dim i As Long
    
    Set rngOut = Application.Range(strOutput).Cells(1)
    
    For i = LBound(vInputRanges) To UBound(vInputRanges)
        Set rngSource = Application.Range(vInputRanges(i))
        Set rngOut = rngOut.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
        rngOut.Value = rngSource.Value
        ' move the output range on to the end of the filled area
        Set rngOut = rngOut.Offset(rngOut.Rows.Count, 0)
    Next i
    

End Sub

Open in new window

Avatar of mlagrange

ASKER

Thanks, Andrew - that works like a charm.
But should the address of the output named range be expanding, as the 3 input ranges are tacked on? At the end of the routine, the output named range address is still the same, even though I'm still seeing all the rows I expected in the new location.

(I'm importing the output range into an Access database, and it would really simplify things if I could refer to the range name, and pull it all in that way.)

Thanks for your response
ASKER CERTIFIED SOLUTION
Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Thanks very much - I appreciate your responding on the weekend!