I have two Excel files I need to merge into one Excel file based on a primary key. I need to do this in vb.net and have no idea where to start. One file is a data list and the other a matrix. I need the matrix fields added to the data list and depending on the primary key the data rows in the data list will be populated by the corresponding matrix row. I have the following but I am unsure if I'm going in the right direction. If so, then how do i save it as a new Excel file?
Dim DT1 As DataTable
DT1.Rows.Add(DtSet)
Dim DT2 As DataTable
DT2.Rows.Add(DtSet2)
DT1.PrimaryKey = New DataColumn() {DT1.Columns(ComboBox1.SelectedItem)}
DT2.PrimaryKey = New DataColumn() {DT1.Columns(ComboBox2.SelectedItem)}
DT1.Merge(DT2)
If I were you, i would use the Excel consolidate feature for this.
https://www.ablebits.com/office-addins-blog/2015/09/01/consolidate-excel-merge-sheets/#consolidate-data-excel
If you really have to use VB for this, you can try the script below.
Sub Merge2Workbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange 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\Peter\invoices\"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = FileName
' Set the source range to be A9 through C9.
' Modify this range for your workbooks.
' It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range("A9:C9")
' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.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
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub
You may find this interesting too.
https://siddharthrout.wordpress.com/2012/06/05/vb-netvba-copy-rows-from-multiple-tabs-into-one-sheet-in-excel/
Related
Hi guys I have a small problem I need help with.
I am trying to copy data from multiple Workbook with the sheet called Auto1 into a master Workbook named Autos. From the multiple Workbooks I need the cell range H18:M3164.
Until here I found a macro that could help me, but then I need to rearrange the information side by side (For example the first workbook selected columns would be pasted in the first A:F columns of the "Autos" workbook, the second workbook selected columns would be pasted in the G:L columns and so on).
The code I have just copies and pastes it in the end so I'm asking if you could give me a hand.
Here is my code so far.
Option Explicit
Sub combine_data()
'
Dim MyPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
'Define folders and filenames
MyPath = "C:\Users\Utilizador\Desktop\Teste\"
SumPath = "C:\Users\Utilizador\Desktop\Teste\Master\"
MyTemplate = "*.xls" 'Set the template.
SumTemplate = "Autos.xlsx"
'Open the template file and get the Worksheet to put the data into
SumName = Dir(SumPath & SumTemplate)
Workbooks.Open SumPath & SumName
Set sumWS = ActiveWorkbook.Worksheets("Sheet1")
'Open each source file, copying the data from each into the template file
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open MyPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Auto1")
'Copy the data from the source and paste at the end of Summary sheet
myWS.Range("H18:M3164").Copy
sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop
'Now all sourcefiles are copied into the Template file. Close and save it
Workbooks(SumName).Close SaveChanges:=True
End Sub
If I understand correctly, you just need to change the paste line. Below assumes you are pasting into row 1.
myWS.Range("H18:M3164").Copy
sumWS.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial
or to base it on the last used row in column A
Dim r As Long
'this line needs to go before the Do loop.
r =sumWS.Range("A" & Rows.Count).End(xlUp).Row + 1
'these stay where they are
myWS.Range("H18:M3164").Copy
sumWS.Cells(r, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlvalues
I have a macro here that consolidates all files into a master file. Currently this copies the entire worksheet from each file and stacks it into the master file. This ideal code will go into source file and find the header row and copy below. The header row is not static. Sometimes its on Row 5, sometimes row 15. There is data above the header and its usually long text strings.
How do I edit the below code to do that?
Thanks In Advance!
Here is the Code:
Sub Consolidate_BST()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim sourceRange As Range
Dim destrange As Range
Worksheets("Consolidate BSts").Range("A1:J50000").ClearContents
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = ThisWorkbook.Sheets("Consolidate BSts")
' Modify this folder path to point to the files you want to use. 'M
FolderPath = "C:\Users\413315\Documents\\March Bluesheets"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = FileName
' Modify this range for your workbooks.
' It can span multiple rows.
Set sourceRange = WorkBk.Worksheets("Regional Estimates").Range("B3:J1000")
' Set the destination range to start at column B and
' be the same size as the source range.
Set destrange = SummarySheet.Range("B" & NRow)
Set destrange = destrange.Resize(sourceRange.Rows.Count, _
sourceRange.Columns.Count)
' Copy over the values from the source to the destination.
destrange.Value = sourceRange.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
' Use Dir to get the next file name.
FileName = Dir()
Loop
SummarySheet.Columns.AutoFit
Worksheets("Consolidate BSts").Range("D2:D50000").ClearContents
End Sub
Assuming that the header is always in the same column, you could add something like the following to the top of your code:
Dim cond As Boolean
Dim headerRow As Integer, i As Integer
cond = False
While cond <> True
i = i + 1
If sourceRange.Cells(i, 1) = "Name of Header" Then 'For a header in column A
i = headerRow
cond = True
End If
Wend
Then with you should be able to modify the range of data that it intakes based on what row the headers are in.
Also you could change the if statement to something more general, but it's hard to know what it should be without knowing what your headers and data look like.
I want to copy values from one workbook and paste them into a master workbook.
The line
Set DestRange = DIAAggregation.Range(1 & NRow)
stops the debugger and gives me the error message:
Method 'Range' of object "_workbook" failed
Upon looking online, I am aware that I am not fully qualifying my range, but I do not see what I can do to fully qualify it.
The code is below, and the line in question is the last line.
Sub DIA_Concatenate()
'
'
'
'
Dim DIAAggregation As Worksheet
Dim DIAMaster As Workbook
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim Month As String
Dim Year As String
' Prompts the user to specify which DIA data
' is being aggregated (Month and Year).
' Useful for checking data source and SaveAs file name.
Month = InputBox("What month's data is being aggregated?")
Year = InputBox("What year's data is being aggregated?")
' Points the macro to the proper data source
' (UPDATE THIS LINE TO YOUR DATA SOURCE!!!)
FolderPath = _
"G:\Analytical Services\General Team Folders\Kyle\DIA Aggregation Bank\"
' Opens the master workbook that is to have data added to it,
' and declares the first sheet for the macro.
Set DIAMaster = Workbooks.Open(FolderPath & "*Aggregation*")
Set DIAAggregation = DIAMaster.Worksheets(1)
' Incrementer to keep track of where new rows should be appended.
NRow = DIAAggregation.Rows.Count + 1
Dim LastRow As Long
' Call Dir the first time,
' pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until all .xl files in the source folder have been read.
Do While FileName <> ""
If InStr(1, FileName, "Aggregation") > 0 Then
FileName = Dir()
GoTo Jump
End If
If InStr(1, FileName, Month) = 0 Then
FileName = Dir()
GoTo Jump
End If
' Open a workbook in the folder.
Set WorkBk = Workbooks.Open(FolderPath & FileName)
Dim J As Integer
' Loop through data sheets to collect data.
For J = 2 To Sheets.Count ' From sheet 2 to last sheet.
' Make the sheet active, find where the data is,
' and select the data.
Sheets(J).Activate
LastRow = WorkBk.Worksheets(J).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(J).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
Set SourceRange = WorkBk.Worksheets(J).Range("A3:E" & LastRow)
' Set the destination range to start at column A and
' be the same size as the source range.
Set DestRange = DIAAggregation.Range(1 & NRow)
Per the last comment, changing the declaration of NRow by adding in .UsedRange between the spreadsheet variable and .Rows resolves the issue PartyHatPanda pointed out.
I am working on copying the contents of several CSV files into a single, new CSV file, and am having trouble with my vba code. I am aware of the CMD tool to copy .csv files, but this does not work for me, as my directory is stored on the network and I can't path to it from the CMD window (I get an error about using a UNC address). My boss would prefer for the code to have zero human interaction, so moving the files to a directory on the computer, running the CMD, and then moving the results back is not an option.
Per my boss's request, the code needs to do the following:
"Every time the macro is run, the new master file should be saved over when it's run so the report pulls the same file each time."
A logical consequence of this is that the macro should catch a particular string in the resulting file name and "skip over" that file when making a new version. Also, every .csv file has headings, so my ranges are set up to avoid copying them.
Below is the code I have written thus far. When I try to run the macro, I get a few errors to come up with the line:
Set WorkBk = Workbooks.Open(FolderPath & FileName)
They're always 1004 messages, and they either say my created file is either read-only/encrypted, or they tell me that Method 'Open' of object 'Workbooks' failed.
What do I need to change or do to get the below code to work? I am confident in this code because I slightly modified it from code I wrote yesterday to do a similar task with .xlsx files. Any help is greatly appreciated, thank you.
Sub CSV_Aggregate()
'
'
'
'
Dim CSVAggregation As Worksheet
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Points the macro to the proper data source (UPDATE THIS LINE TO YOUR DATA SOURCE!!!)
FolderPath = "\\usilsvr01\lin#mktg\Analytical Services\DIA\Offers Data Question to Exclude"
' Creates a blank workbook to host the aggregation, and names the first worksheet appropriately.
Set CSVAggregation = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
Sheets(1).Name = "DIA Aggregation"
' Heads the worksheet with the relevant fields to be aggregated.
CSVAggregation.Range("A1:C1") = Array("Manufacturer Number", "Offer Code", "Data Question")
' Incrementer to keep track of where new rows should be appended.
NRow = 2
Dim LastRow As Long
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.csv")
' Loop until all .csv files in the source folder have been read.
Do While FileName <> ""
' Macro should skip over the previous version of the aggregate file
If InStr(1, FileName, "Aggregate") > 0 Then
FileName = Dir()
End If
' Open a workbook in the folder.
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Loop through data sheets to collect data.
Sheets(1).Activate ' Make the sheet active, find where the data is, and select the data.
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
Set SourceRange = WorkBk.Worksheets(1).Range("A2:C" & LastRow)
' Set the destination range to start at column A and
' be the same size as the source range.
Set DestRange = DIAAggregation.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increment NRow so that data is not overwritten.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all data is readable.
CSVAggregation.Columns.AutoFit
CSVAggregation.Rows.AutoFit
' Places cursor on the first sell so document doesn't open highlighted or anywhere besides the top.
CSVAggregation.Range("A1").Select
' Creates variable to hold SaveAs name for Aggregation Report.
Dim workbook_Name As String
workbook_Name = "CSV Aggregate"
' Saves the workbook in the folder that the data is found in (BE SURE TO CHECK TAHT YOU HAVE THE FOLDER/FILES WITH WHICH YOU SHOULD BE WORKING!!!!)
ActiveWorkbook.SaveAs FileName:=(FolderPath & workbook_Name), FileFormat:=6
End Sub
Okay, I was able to make a few changes to get my code to work.
Here is the final code:
Sub CSV_Aggregate()
'
'
'
'
Dim CSVAggregation As Worksheet
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Points the macro to the proper data source (UPDATE THIS LINE TO YOUR DATA SOURCE!!!)
FolderPath = "\\usilsvr01\lin#mktg\Analytical Services\DIA\Offers Data Question to Exclude\"
' Creates a blank workbook to host the aggregation, and names the first worksheet appropriately.
Set CSVAggregation = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
Sheets(1).Name = "DIA Aggregation"
' Heads the worksheet with the relevant fields to be aggregated.
CSVAggregation.Range("A1:C1") = Array("Manufacturer Number", "Offer Code", "Data Question")
' Incrementer to keep track of where new rows should be appended.
NRow = 2
Dim LastRow As Long
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.csv")
' Loop until all .csv files in the source folder have been read.
Do While FileName <> ""
' Macro should skip over the previous version of the aggregate file
If InStr(1, FileName, "Aggregate") > 0 Then
FileName = Dir()
End If
' Open a workbook in the folder.
Set WorkBk = Workbooks.Open(FolderPath & FileName, , True)
' Loop through data sheets to collect data.
Sheets(1).Activate ' Make the sheet active, find where the data is, and select the data.
LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
SearchDirection:=xlPrevious, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows).Row
Set SourceRange = WorkBk.Worksheets(1).Range("A2:C" & LastRow)
' Set the destination range to start at column A and
' be the same size as the source range.
Set DestRange = CSVAggregation.Range("A" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increment NRow so that data is not overwritten.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
Loop
' Call AutoFit on the destination sheet so that all data is readable.
CSVAggregation.Columns.AutoFit
CSVAggregation.Rows.AutoFit
' Places cursor on the first sell so document doesn't open highlighted or anywhere besides the top.
CSVAggregation.Range("A1").Select
' Creates variable to hold SaveAs name for Aggregation Report.
Dim workbook_Name As String
workbook_Name = "CSV Aggregate"
' Saves the workbook in the folder that the data is found in (BE SURE TO CHECK TAHT YOU HAVE THE FOLDER/FILES WITH WHICH YOU SHOULD BE WORKING!!!!)
ActiveWorkbook.SaveAs FileName:=(FolderPath & workbook_Name), FileFormat:=6
End Sub
I added a final "\" at the FilePath declaration.
I also rewrote the set WorkBk line as:
Set WorkBk = Workbooks.Open(FolderPath & FileName, , True)
This resolved the "read only" error I was getting.
You can use the pushd command to get around the UNC/network folder issue in cmd. It assigns a temporary drive letter to the network folder and allows you to continue as normal.
first time poster on here (and a novice coder!), so I hope I can explain myself well, as I've been struggling to find an answer to this when searching on the internet.
My company has a very simple timesheet system at the moment that uses Excel, with everyone sending a predefined workbook at the end of the week with a list of tasks that they have done, split by half days (so it could say Friday AM - Admin, Friday PM - analysis, for example). In order to make life simple for the person who has to use all this data for project costs, I have made a named range in the timesheets people use called DataRange that can then be called in VBA.
I've made a workbook that allows her to click a button and specify a directory for where all the timesheets she wants to import are, and after selecting all these, it loops through each one, finds the DataRange and pastes it into a new workbook, one after another, putting Timesheet_Name in the A column, and the date in the B column.
My next step is to allow for new tables to be created using this data. Within the loop a new named range is created that covers all the data pasted in from the timesheet workbook, and gives it the name of whatever is in the A column (so if the first timesheet in the loop was pasted in, the name would be Timesheet_JohnSmith, and the range would cover all of the data that came from the timesheet workbook.)
This all works great, however, I am having a problem in that when these new named ranges are created, they are set to a scope of the worksheet they're in, rather than the workbook as a whole. This means that if you want to use them in other worksheets (which is my future intention in order to create these into new tables), you have to refer to them as (for example, if they were on sheet 1 in the workbook) Sheet1!Timesheet_JohnSmith rather than just Timesheet_JohnSmith.
My code is below, it is the line that says: SummarySheet.Names.Add Name:=setUserName, RefersTo:=DestRange where the new named ranges are set. What I want to know is why it is setting it to the scope of just the worksheet it is in and if there is a simple way to change it to the scope of the whole workbook. Thank you!
Sub MergeSelectedWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim SelectedFiles() As Variant
Dim NRow As Long
Dim FileName As String
Dim getUserFileName() As String
Dim setUserName As String
Dim NFile As Long
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(x1WBATWorksheet).Worksheets(1)
SummarySheet.SaveAs ("SummaryTest")
Workbooks("SummaryTest.xlsx").Activate
ActiveWorkbook.Sheets.Add
' Modify this folder path to point to the files you want to use.
FolderPath = Worksheets("Summary").Range("FilePath")
' 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)
' Get the file name to be used for column A, removing the path and file extension
getUserFileName = Split(FileName, "\")
setUserName = getUserFileName(UBound(getUserFileName))
setUserName = Replace(setUserName, ".xlsx", "")
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = setUserName
SummarySheet.Range("B" & NRow).Value = Date
' Set the source range to be A9 through C9.
' Modify this range for your workbooks. It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range("DataRange")
' Set the destination range to start at column B and be the same size as the source range.
Set DestRange = SummarySheet.Range("C" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
'Create the name range in the new workbook to be used for future calculations
SummarySheet.Activate
SummarySheet.Names.Add Name:=setUserName, RefersTo:=DestRange
' 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
It's doing what you told it to - which was to add the Name to the sheet, not the workbook. You can just use:
DestRange.Name = setUserName