PDA

View Full Version : [SOLVED] Non-Contiguous columns in multiple workbooks into New Workbook - Efficiency?



dimsumpanda
07-27-2015, 07:54 AM
Hello, I would like to combine data from non-contiguous columns from multiple workbooks and paste the data together into a summary workbook. I want to combine columns A:C and column E:F, and column L from multiple workbooks (these are arbitrary columns that I picked to work with).

Looking online, I found a really helpful tutorial on how to merge data from multiple workbooks into a Summary Workbook:
https://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx
However, I can only seem to merge data from one range of columns at a time. I tried to use Union(DestRange, DestRange2), but DestRange2 (the second range) doesn't appear in the new workbook.

Instead, I separated the column ranges and repeated the copy and paste methods 3 times with each different range. This works, but I feel like there should be a much more efficient way of doing this. I am very new to VBA, so any help would be extremely appreciated! >_<



Sub MergeData() Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim NRow As Long
Dim FileName As String
Dim NFile As Long
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim DestRange2 As Range
Dim DestRange3 As Range
Dim SourceRange2 As Range
Dim SourceRange3 As Range

' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Documents\ExcelVBApractice\"

' Set the current directory to the the folder path.
ChDrive FolderPath
ChDir FolderPath

' Open the file dialog box and filter on Excel files, allowing multiple files
' to be selected.
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
' Set FileName to be the current workbook file name to open.
FileName = SelectedFiles(NFile)

' Open the current workbook.
Set WorkBk = Workbooks.Open(FileName)



' Create the variable for the last row.
Dim LastRow As Long
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
' Set the source range, i.e. the columns to copy.
Set SourceRange = WorkBk.Worksheets(1).Range("$A$1:$C$" & LastRow)
Set SourceRange2 = WorkBk.Worksheets(1).Range("$E$1:$F$" & LastRow)
Set SourceRange3 = WorkBk.Worksheets(1).Range("$L$1:$L$" & LastRow)

' Set the destination range to start at column A and be the same size as the source range.
Set DestRange = SummarySheet.Range("A" & NRow)
Set DestRange2 = SummarySheet.Range("D" & NRow)
Set DestRange3 = SummarySheet.Range("F" & NRow)

' Modify this range for your workbooks. It can span multiple rows.
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
Set DestRange2 = DestRange2.Resize(SourceRange2.Rows.Count, SourceRange2.Columns.Count)
Set DestRange3 = DestRange3.Resize(SourceRange3.Rows.Count, SourceRange3.Columns.Count)

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
DestRange2.Value = SourceRange2.Value
DestRange3.Value = SourceRange3.Value

' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
Next NFile

' Call AutoFit on the destination sheet so that all data is readable.
SummarySheet.Columns.AutoFit




End Sub






If I am working with a lot of non-contiguous columns that appear in multiple workbooks, how can I combine them into one workbook efficiently?
If I want to select columns singularly (instead of E:F, just column E), would I still use the Range method or the Column method?
I attached the world fertility rate dataset that I pulled from the worldbank. I separated the information into 2 different workbooks and deleted several columns and worksheets to make the file smaller. If you run the code and select both worksheets, it should look like the whatItShouldLookLike.xlsx file.
If I only want columns A:C, E:F (2005-2006), and column L (2012) from the two workbooks, how can I use VBA to without repeating the methods manually?

p45cal
07-27-2015, 11:58 AM
try:
Sub MergeData2()
Dim SummarySheet As Worksheet, FolderPath As String, SelectedFiles(), NRow As Long
Dim FileName As String, NFile As Long, WorkBk As Workbook, SourceRange As Range
Dim DestRange As Range, LastRow As Long

' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Modify this folder path to point to the files you want to use.
FolderPath = "C:\Users\Documents\ExcelVBApractice\"
' Set the current directory to the the folder path.
ChDrive FolderPath
ChDir FolderPath
' Open the file dialog box and filter on Excel files, allowing multiple files to be selected.
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
' Set FileName to be the current workbook file name to open.
FileName = SelectedFiles(NFile)
' Open the current workbook.
Set WorkBk = Workbooks.Open(FileName)
' Create the variable for the last row.
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", After:=WorkBk.Worksheets(1).Cells.Range("A1"), SearchDirection:=xlPrevious, LookIn:=xlFormulas, SearchOrder:=xlByRows).Row
' Set the source range, i.e. the columns to copy.
Set SourceRange = WorkBk.Worksheets(1).Range("$A$1:$C$" & LastRow & ", $E$1:$F$" & LastRow & ", $L$1:$L$" & LastRow)
' Set the destination range to top left cell of destination.
Set DestRange = SummarySheet.Range("A" & NRow)


' Copy over from the source to the destination.
'Use:
SourceRange.Copy DestRange ' can use this line instead of the 3 below - it copies everything, formats and all.
'or these next 3 which copy over only the values (dates look ugly):
' SourceRange.Copy
' DestRange.PasteSpecial xlPasteValues
' Application.CutCopyMode = False


' Increase NRow so that we know where to copy data next.
NRow = NRow + SourceRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
Next NFile
' Call AutoFit on the destination sheet so that all data is readable.
SummarySheet.Columns.AutoFit
'Application.Goto SummarySheet.Cells(1, 1) 'this line only needed to select A1 if xlPasteValues is used above.
End Sub
Comments in code re variations.

Can also try:
Sub MergeData3()
Dim SummarySheet As Worksheet, FolderPath As String, SelectedFiles(), NRow As Long, FileName

Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
FolderPath = "C:\Users\Documents\ExcelVBApractice\"
ChDrive FolderPath
ChDir FolderPath
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
NRow = 1
' Loop through the list of returned file names
For Each FileName In SelectedFiles
With Workbooks.Open(FileName).Worksheets(1)

'Copy over from the source to the destination.
'Use:
Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy SummarySheet.Cells(NRow, 1) ' can use this line instead of the 3 below - it copies everything, formats and all.
'or these next 3 which copy over only the values (dates look ugly):

'Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy
'SummarySheet.Cells(NRow, 1).PasteSpecial xlPasteValues
'Application.CutCopyMode = False

.Parent.Close savechanges:=False
End With 'Workbooks.Open(FileName).Worksheets(1)
'Update NRow:
NRow = SummarySheet.UsedRange.Rows(SummarySheet.UsedRange.Rows.Count).Row + 1
Next FileName
SummarySheet.Columns.AutoFit
'Application.Goto SummarySheet.Cells(1, 1) 'this line only needed to select A1 if xlPasteValues is used above.
End Sub
Again see comments in code.

dimsumpanda
07-27-2015, 01:57 PM
Oh wow!! Thank you so much; both macros work wonderfully and the code look much nicer than before! If you don't mind, I do have a few questions and comments as I was trying to learn from the code you posted.


Range("$A$1:$C$" & LastRow & ", $E$1:$F$" & LastRow & ", $L$1:$L$" & LastRow).

Ah, so that's how I can combine several columns into a range! I was looking all over trying to figure out how to do it.
How come the commas go inside the quotation marks? I tried to move them and I got an error. Is it because the '& 'connects the two strings together? (I'm still very new to the VBA syntax)

The copy and paste method is also really nice. Thank you for adding the comments. I came across the three lines of code that can help copy and paste ranges before, but I didn't know there was a short-hand for it.

Hmmm... I looked up intersect and UsedRange. I understand intersect now, but what does UsedRange do here?:

Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy SummarySheet.Cells(NRow, 1)

p45cal
07-28-2015, 02:25 AM
How come the commas go inside the quotation marks? I tried to move them and I got an error. Is it because the '& 'connects the two strings together? (I'm still very new to the VBA syntax)
If you record a macro of you selecting those columns you get:
Range("A:C,E:F,L:L").Select
from which you can see where the commas go. Duplicate that.

Hmmm... I looked up intersect and UsedRange. I understand intersect now, but what does UsedRange do here?:

Intersect(.UsedRange, .Range("A:C,E:F,L:L")).Copy SummarySheet.Cells(NRow, 1)Add a new sheet, put something in C10 and something in F3, then in the Immediate pane (Ctrl+G if you can't see it in the VBE) type:
Activesheet.usedrange.select
then look at the sheet. This should give you a good idea of what it is.
Excel's own help says: "Returns a Range object that represents the used range on the specified worksheet."

dimsumpanda
07-28-2015, 06:12 AM
Now I get it, thank you. :)

Opeyrasse
01-18-2016, 03:58 AM
Hi, I am using the same code and have found it really useful reading through this so thanks. In my case however I am trying to select different columns for each of the 2 source files and can't for the life of me how to go about it as the looping function obviously uses the same column mapping.

I'm trying map the following sourcesheet columns TO output worksheet columns:
Sheet 1:
C TO A
D TO B
E TO C
I TO D

Sheet 2:
B TO F
J TO G
H TO H
C TO I

How can I adapt this code to allow for this? Any help is massively appreciated... I feel I am going around in circles at the moment :-(

Thanks,

Olivier

p45cal
01-18-2016, 06:00 AM
Untested, just changing the for..next loop:
For Each FileName In SelectedFiles
With Workbooks.Open(FileName)
With .Worksheets(1)
Intersect(.UsedRange, .Range("C:E,I:I")).Copy SummarySheet.Cells(NRow, 1) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("C:E,I:I")).Copy
'SummarySheet.Cells(NRow, 1).PasteSpecial xlPasteValues
End With '.Worksheets(1)
With .Worksheets(2)
Intersect(.UsedRange, .Range("B:B")).Copy SummarySheet.Cells(NRow, 6) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("B:B")).Copy
'SummarySheet.Cells(NRow, 6).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("J:J")).Copy SummarySheet.Cells(NRow, 7) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("J:J")).Copy
'SummarySheet.Cells(NRow, 7).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("H:H")).Copy SummarySheet.Cells(NRow, 8) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("H:H")).Copy
'SummarySheet.Cells(NRow, 8).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("C:C")).Copy SummarySheet.Cells(NRow, 9) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("C:C")).Copy
'SummarySheet.Cells(NRow, 9).PasteSpecial xlPasteValues

'Application.CutCopyMode = False 'this line only needed when using the xlPasteValues lines above.
End With '.Worksheets(2)
.Parent.Close savechanges:=False
End With 'Workbooks.Open(FileName)

.Worksheets(1) and .Worksheets(2) in the code above refer to the worksheets in the order they appear in in the workbook you're copying from. If they have consistent names then you can substitute .Worksheets("TheFirstSheet") and .Worksheets("SomeOtherSheet") obviously using the names of your actual worksheets instead.

Opeyrasse
01-18-2016, 06:36 AM
Hi p45cal,

Thanks so much for helping out with this, and so quickly! I think I didn't explain very well however... the two sourcesheets are in different workbooks. I.e. each is a different file, and each is in sheet 1 of their respective workbooks.

I think with your previous comment, it will work with different sheets but not different workbooks.

Thanks again,

Olivier


Untested, just changing the for..next loop:
For Each FileName In SelectedFiles
With Workbooks.Open(FileName)
With .Worksheets(1)
Intersect(.UsedRange, .Range("C:E,I:I")).Copy SummarySheet.Cells(NRow, 1) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("C:E,I:I")).Copy
'SummarySheet.Cells(NRow, 1).PasteSpecial xlPasteValues
End With '.Worksheets(1)
With .Worksheets(2)
Intersect(.UsedRange, .Range("B:B")).Copy SummarySheet.Cells(NRow, 6) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("B:B")).Copy
'SummarySheet.Cells(NRow, 6).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("J:J")).Copy SummarySheet.Cells(NRow, 7) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("J:J")).Copy
'SummarySheet.Cells(NRow, 7).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("H:H")).Copy SummarySheet.Cells(NRow, 8) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("H:H")).Copy
'SummarySheet.Cells(NRow, 8).PasteSpecial xlPasteValues
Intersect(.UsedRange, .Range("C:C")).Copy SummarySheet.Cells(NRow, 9) ' can use this line instead of the 2 below - it copies everything, formats and all.
'or these next 2 which copy over only the values (dates look ugly):
'Intersect(.UsedRange, .Range("C:C")).Copy
'SummarySheet.Cells(NRow, 9).PasteSpecial xlPasteValues

'Application.CutCopyMode = False 'this line only needed when using the xlPasteValues lines above.
End With '.Worksheets(2)
.Parent.Close savechanges:=False
End With 'Workbooks.Open(FileName)

.Worksheets(1) and .Worksheets(2) in the code above refer to the worksheets in the order they appear in in the workbook you're copying from. If they have consistent names then you can substitute .Worksheets("TheFirstSheet") and .Worksheets("SomeOtherSheet") obviously using the names of your actual worksheets instead.

snb
01-18-2016, 10:14 AM
For Each FileName In SelectedFiles
With getobject(FileName)
sn= .sheets(1).usedrange
.close 0
end with

sp=application.index(sn,evaluate("row(1:"&ubound(sn)&")"),array(3,4,5,9,2,10,8)
summarysheet.cells(rows.count,1).end(xlup).offset(2).resize(ubound(sp),ubou nd(sp,2))=sp
next

p45cal
01-18-2016, 12:39 PM
How are you going to go about selecting files? Only 2 at a time?