Consolidating Data Ranges into One Column

[zdodson]

I am attempting to extract unique values from (3) different worksheets from (4) ranges using Excel VBA so I can then use a dynamic range to populate a combobox in a userform.

Sheet 1 (Range F1 through last row)
Sheet 1 (Range G1 through last row)
Sheet 2 (Range A2 through last row)
Sheet 3 (Range A2 through last row)

I am attempting to copy and paste in an Admin Sheet that has my dynamic ranges. Once I pull Sheet 1 (F1 through last row), I want to paste it in the Admin sheet. Next, I want to pull Sheet 1 (Range G1 through last row) and paste it underneath my data I just pasted in the Admin sheet.

I want to do this for all four ranges without deleting previous data. Can someone point me in the right direction?

 

[RSpin]

Here's what I came up with:

Sub merge()


' Create variables
Dim Lrow As Double
Dim LrowTemp As Long
Dim Arr() As Variant
Dim Ranout As Range
Dim Ranin As Range
Dim docname As String
Dim thisbook As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim admn As Worksheet


' set intitial variables
docname = ActiveWorkbook.Name
Set thisbook = Workbook(docname)
Set sh1 = thisbook.Worksheet("Sheet1") ' change this to match your sheet name
Set sh2 = thisbook.Worksheet("Sheet2") ' change this to match your sheet name
Set sh3 = thisbook.Worksheet("Sheet3") ' change this to match your sheet name
Set admn = thisbook.Worksheet("Admin") ' change this to match your sheet name
Lrow = 1
LrowTemp = 0


' Bring in first range
LrowTemp = sh1.Range("F100000").End(xlUp).Row ' if your Last row has the possiblility of being 100,000 or higher, then change the row this starts on to something safely higher than what you will use
Set Ranout = sh1.Range("F1:F" & LrowTemp)
Set Ranin = admn.Range("A" & Lrow & ":A" & LrowTemp)    ' Change both "A"s to which ever column you want to use
ReDim Arr(1 To LrowTemp)
Arr = Ranout
Ranin = Arr
Lrow = Lrow + LrowTemp


' Bring in second range
LrowTemp = sh1.Range("G100000").End(xlUp).Row ' if your Last row has the possiblility of being 100,000 or higher, then change the row this starts on to something safely higher than what you will use
Set Ranout = sh1.Range("G1:G" & LrowTemp)
Set Ranin = admn.Range("A" & Lrow & ":A" & LrowTemp)    ' Change both "A"s to which ever column you want to use
ReDim Arr(1 To LrowTemp)
Arr = Ranout
Ranin = Arr
Lrow = Lrow + LrowTemp


' Bring in thrid range
LrowTemp = sh2.Range("A100000").End(xlUp).Row ' if your Last row has the possiblility of being 100,000 or higher, then change the row this starts on to something safely higher than what you will use
Set Ranout = sh2.Range("A2:A" & LrowTemp)
Set Ranin = admn.Range("A" & Lrow & ":A" & (LrowTemp - 1))   ' Change both "A"s to which ever column you want to use
ReDim Arr(2 To LrowTemp)
Arr = Ranout
Ranin = Arr
Lrow = Lrow + LrowTemp - 1


' Bring in fourth range
LrowTemp = sh3.Range("A100000").End(xlUp).Row ' if your Last row has the possiblility of being 100,000 or higher, then change the row this starts on to something safely higher than what you will use
Set Ranout = sh3.Range("A2:A" & LrowTemp)
Set Ranin = admn.Range("A" & Lrow & ":A" & (LrowTemp - 1))   ' Change both "A"s to which ever column you want to use
ReDim Arr(2 To LrowTemp)
Arr = Ranout
Ranin = Arr
Lrow = Lrow + LrowTemp - 1


End Sub

If it's not quite what you need, then, hopefully, it will help point you in the right direction.

 

[My Aswer Is This]

Try this:

Assuming your copy to sheet is named "Admin"

Sub Copy_Me()
'Modified 12/16/2018 5:52:59 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow1 As Long
Dim Lastrow2 As Long
Dim Lastrow3 As Long
Dim Lastrow4 As Long
Dim Lastrowadmin As Long
Lastrow1 = Sheets(1).Cells(Rows.Count, "F").End(xlUp).Row
Lastrow2 = Sheets(1).Cells(Rows.Count, "G").End(xlUp).Row
Lastrow3 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
Lastrow4 = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowadmin = Sheets("Admin").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets(1).Range("F1:F" & Lastrow1).Copy Sheets("Admin").Cells(Lastrowadmin, 1)
Lastrowadmin = Sheets("Admin").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets(1).Range("G1:G" & Lastrow2).Copy Sheets("Admin").Cells(Lastrowadmin, 1)
Lastrowadmin = Sheets("Admin").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets(2).Range("A2:A" & Lastrow3).Copy Sheets("Admin").Cells(Lastrowadmin, 1)
Lastrowadmin = Sheets("Admin").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets(3).Range("A2:A" & Lastrow4).Copy Sheets("Admin").Cells(Lastrowadmin, 1)

Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub zdodson()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Sheet1", "F1", "Sheet1", "G1", "Sheet2", "A2", "Sheet3", "A2")
   For i = 0 To UBound(Ary) Step 2
      With Sheets(Ary(i))
         .Range(Ary(i + 1), .Range(Left(Ary(i + 1), 1) & Rows.Count).End(xlUp)).Copy Sheets("Admin").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End With
   Next i
End Sub

 

[zdodson]

How about

Sub zdodson()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Sheet1", "F1", "Sheet1", "G1", "Sheet2", "A2", "Sheet3", "A2")
   For i = 0 To UBound(Ary) Step 2
      With Sheets(Ary(i))
         .Range(Ary(i + 1), .Range(Left(Ary(i + 1), 1) & Rows.Count).End(xlUp)).Copy Sheets("Admin").Range("A" & Rows.Count).End(xlUp).Offset(1)
      End With
   Next i
End Sub

After working with the examples it looks like Fluff had the best solution. Thanks all!

 

[Fluff]

You're welcome & thanks for the feedback

 

[zdodson]

You're welcome & thanks for the feedback

For this code, I have a couple of questions:

1) What does the Step # refer to? I have seen some code examples indicate "Step 1", some "Step 2".
2) Are there any limitations to using the Array method (Ary = Array("Sheet1", "F1"..."), such as number of ranges you can reference?

 

[Fluff]

The step determines how much the counter increments each time through the loop.
So initially i will be 0, then the second time through the loop i will be 2, then 4 etc.
I'm not sure if there is a limit to the size of the array when creating it like this, but I've never had any problems.