This question already has an answer here:
Copying data from many workbooks to a summary workbook with Excel-VBA. Run time errors
(1 answer)
Closed 4 years ago.
Apologies if I over-word my dilemma. I want to make sure I'm crystal clear.
I have a workbook with a macro I wrote that analyzes and consolidates a large amount of data. The workbook itself has two worksheets: "Data Entry" and "Output". Data entry has the macro buttons within the first row, so the data starts at Cell "A2". Output is where the end data is placed, starting at Cell "A1".
What I would like to do is build upon the macro to be used in processing multiple files of raw data in a single process. Bear in mind none of the raw data files will be opened. Only the one running this macro. I would like to have the workbook itself:
Pull the worksheet data from all files in a folder, one at a time. There will be a variable amount of files in this folder. (To clarify, each raw data file placed into this folder will be a single worksheet with the data starting at Cell "A1", and the name of said files will vary)
Pull said data from a file and import it into "Data Entry" at Cell "A2"
Run my code, process the data and dump it into the worksheet "Output". (It's worth noting that "Data Entry" is 30 columns wide with variable row length, and output is variable in column and row length)
Take what is within the worksheet "Output", return it to the file it grabbed the raw data from, but in a new worksheet on the raw data workbook.
Loop this process until all raw data files have been run through the the workbook and have an "Output" worksheet.
The following will loop through a folder and add all filenames into an array if they have an .xlsm extension, this could be changed for whatever file you are looking for, then you can loop through the array to open each file and do whatever you need:
Sub LoopThroughDirectory()
Dim Arr() As String
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
FolderPath = "C:\Users\YOU\Documents"
Set objFolder = objFSO.GetFolder(FolderPath)
i = 0
For Each objSubFolder In objFolder.Files
'Debug.Print objSubFolder.Name
If Right(objSubFolder.Name, 4) = "xlsm" Then 'if file extension is = xlsm then add to array
ReDim Preserve Arr(i + 1)
Arr(i) = objSubFolder.Name
i = i + 1
End If
Next
For x = LBound(Arr) To UBound(Arr)
'Go through each file in your array
Next x
End Sub
Related
This is my first question on this site and I'm not a programmer, so please bear with me.
I am trying to create an Excel 2013 macro that will compare values in column A on one workbook ("active workbook") to column A's of other Excel files in a particular directory. Duplicate values (rows) would then be deleted from the active workbook.
I have been working piece by piece trying to figure this out as I am not a programmer. So far I have been able to use conditional formatting to highlight unique values when the two columns are side by side (same worksheet). I used =ISNA(MATCH($A2,$B$2:$B$12,0)).
Then I used a macro to print out the duplicate values to another column (instead of highlighting them.. I am still at this stage comparing two columns within the same worksheet). I did this by using the following macro:
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant
' Set CompareRange equal to the range to which you will
' compare the selection.
Set CompareRange = Range("C1:C12")
' NOTE: If the compare range is located on another workbook
' or worksheet, use the following syntax.
' Set CompareRange = Workbooks("Book2"). _
' Worksheets("Sheet2").Range("C1:C5")
'
' Loop through each cell in the selection and compare it to
' each cell in CompareRange.
For Each x In Selection
For Each y In CompareRange
If x = y Then x.Offset(0, 1) = x
Next y
Next x
End Sub
Then I tried removing duplicate values from two different worksheets but that didn't work:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range
Dim Counter As Integer
Set wb1 = ActiveWorkbook
Set PasteStart = [RRimport!A1]
Pathname = ActiveWorkbook.Path & "\For Macro to run\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb2 = Workbooks.Open(Pathname & Filename)
For Each Sheet In wb2.Sheets
With Sheet.UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Next Sheet
wb2.Close
Filename = Dir()
Loop
End Sub
I've been reading this site for couple of days and also searched through YouTube. I haven't had much success after the first two basic things I did.
Background of the project: Everyday we have a list called "Pending List" which essentially is all of the projects we need to get done. Everyday this list grows. Each project is given a unique identifier (numeric value) that is listed in column A of the active workbook. Every day I create my own files of the projects that are being completed. Instead of manually checking off each project one by one by comparing several files every day, I would like Excel to be able to delete the duplicates (meaning the projects that are both on my pending list and in the other files, and only leave the unique projects that still need to be done. Hope I didn't confuse anyone but if I did, please let me know.
The question here:
I am trying to create an Excel 2013 macro that will compare values in
column A on one workbook ("active workbook") to column A's of other
Excel files in a particular directory. Duplicate values (rows) would
then be deleted from the active workbook.
So, let's break this down:
There is a directory from which workbooks need to be opened.
When one of the workbooks is open, you want to check column A (I assume this is on the first worksheet for the sake of the example below) for values you have in column A in your active workbook (the one that will run the macro).
If there's a match, delete the row from the active workbook in which the value was stored.
When done, continue with the next workbook in the directory.
Point 1 and 4: Open some files from a specific directory:
We will need some function to open and close the files. This question has been asked many times on SO, for example here
Also, we're going to need the workbooks to be stored in some variable that we will pass to the comparison in the next step.
Public Sub LoopOverFiles()
'Our variables:
Dim wb1 As Workbook 'To hold the active workbook / the macro workbook
Dim wb2 As Workbook 'To hold the workbook we'll be comparing to later on
Dim scanFolder As String 'To set the folder in which the files will be located
Dim fileNameToOpen As String 'To get the filenames that we will open
Set wb1 = ThisWorkbook
scanFolder = "C:\temp\"
fileNameToOpen = Dir(scanFolder & "*.xlsx")
'And loop over the files:
Do While Len(fileNameToOpen) > 0 'To exit the loop when there's no more xlsx files
Set wb2 = Workbooks.Open(scanFolder & fileNameToOpen)
'To do the actual comparison of the 2 workbooks, we call our compare routine.
DoTheComparison wb1, wb2 'Note we'll be passing the two workbooks as parameters to the compare function
wb2.Close SaveChanges:=False 'We don't want to leave it open after we're done with it.
fileNameToOpen = Dir 'To continue with the next file.
Loop
End Sub
Point 2 and 3: Do the comparison and delete some rows
As you can see, the actual comparison will be done by a routine that's called DoTheComparison and that takes 2 workbooks as parameters. Based on the first routine, we know that the workbooks that will be passed are the correct ones (wb1 being the active one, wb2 being the variable one that gets opened during the loop).
In this example we'll stick to the first worksheet in wb2.
Public Sub DoTheComparison(wb1 as Workbook, wb2 as Workbook)
'Dim compareFrom as Range - Not needed.
Dim compareTo as Range
Dim compareFromCell as Range
Dim compareToCell as Range
Dim i as Integer
'EDIT: Since we delete, we need a backwards loop. This can't be done with "for each" so we'll use "for" with step -1.
'That is why we also don't need the "CompareFrom" range variable anymore.
Set compareTo = wb2.Worksheets(1).Range("A2:A20")
For i = 20 to 2 step -1
Set compareFromCell = wb1.Worksheets("RemoveValsFromHere").Range("A" & i) 'We get the cells based on the index.
For Each compareToCell in compareTo
If compareFromCell.Value = compareToCell.Value Then 'Point 3:
compareFromCell.EntireRow.Delete shift:=xlUp
Exit For
'Note that we need to exit the inner loop:
'After a match was found, the "compareFromCell" is deleted after all.
'Therefore we have to continue with the next compareFromCell, otherwise we'll get an error.
End If
Next compareToCell
Next i
End Sub
Note that especially DoTheComparison is written for maximum clarity, not for optimal speed (far from it!). I see in your question you've been looking into comparing variants / arrays, which is indeed a lot faster.
EDIT: I altered the code above since you're facing the "skipping cells" issue due to cell deletion. In short: The index changes, so when moving to the next cell after deletion the index is wrong. The fix is an easy backwards for loop. Also see this question and answer
Private Sub CommandButton1_Click()
Dim ws As Worksheet
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count <> 0 Then
fldr = .SelectedItems(1)
End If
End With
Sheets.link.Value = fldr
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
If ws.Cells(2, 1) = "X" Then
Sheets.ComboBox1.AddItem (ws.Name)
End If
Next i
Workbooks.Open (fldr)
Sheets.Show
End Sub
Private Sub Add_Click()
Dim x As String
Dim ws As Workbook
x = Right(link.Value, (Len(link.Value) - InStrRev(link.Value, "ild") - 3))
Workbooks("Test.xlsm").Activate
Worksheets(ComboBox1.Value).Copy Before:=Workbooks(x).Worksheets("Contract")
End Sub
So the basic idea is, you click a button on an Excel sheet. The user then finds the file they want to copy the sheets to. It will find all of a specific type of sheet, put it in a forms combobox and open the selected Excel file.
Then you choose a sheet from the combobox and copy it from one workbook to the other. It all works until the copying part. I get a long error:
Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns that the source workbook. To move or copy the data to the destination workbook, you can select the data and then use Copy and Paste commands to insert it into the sheets of another workbook.
If the destination workbook comes from an older version of Excel (extension .xls for instance, Excel 97 or Excel 2003), the limit of number of rows in old worksheets is 2^16-1, as the row number is encoded on 16 bits. In newer versions, this number is encoded on 32 bits.
Hence, copying a worksheet "as a whole" from a newer version into a workbook from an older version raises this error. From my test, this error occurs even if the actually used range in the copied worksheet is small.
I had this same problem.
Following #A.S.G. suggestion, I saved the old workbook with the new file format (xlsx), closed and reopened it and everything worked fine afterwards.
Hope it helps.
I have a folder of .xlsx files, each identical in layout.
I need to write a macro in excel to open each file in turn (100+ files)
then get the data (a name) from a single cell, and drop it in a new excel worksheet, move on to the next and insert that below the last one etc.
Giving me basically a list of names from data not file names)
Here is (pretty much) exactly what you're trying to do. Next time do a little bit of googling before you ask! :)
http://www.excel-easy.com/vba/examples/files-in-a-directory.html
ROUGH CODE UNSURE IF IT WILL WORK: But here is the basic idea of what you need to modify in the example I sent you. If you look at the example again, it does everything you need and then some. Since you weren't interested in all worksheets, you don't have to loop through all worksheets in a workbook. You can just open it up, read your cell of interest, and then close it. The Do While loop will do this for every Excel file in your directory. AGAIN! Please modify this example accordingly before you use it.
Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer
Application.ScreenUpdating = False
directory = "c:\test\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
i = i + 1
Workbooks.Open (directory & fileName)
Workbooks("files-in-a-directory.xls").Worksheets(1).Cells(i, 1).Value = Workbooks(fileName).Worksheets(1).Cells(x, y) <-- whatever your cell of interest is
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
I am a novice at Visual Basic. I can use either Excel 2010 or Excel 2013 for this task.
I have dozens of workbooks with data on the first worksheet of each. For example One.xlsx, Two.xlsx, Three.xlsx, Four.xlsx each contain information on their respective Sheet1.
I need the information on Sheet1 from each workbook to be combined into a single workbook with sheets that are named from the file name of the original workbook. So for example combined.xlsx would have 4 sheets named One, Two, Three, Four. In every case all information on the underlying worksheets should be copied and combined in the new Workbook as shown below.
The Format I need
I found this Macro / Add-In online that gets me close to what I need using the open files add in choice.
http://www.excelbee.com/merge-excel-sheets-2010-2007-2013#close
The Open Files Add-In successfully allows me to aggregate the various Workbook's worksheets into a single workbook. However the tabs are not named from the name of the original file.
Correct aggregation of sheets, but incorrect worksheet names.
For now all the underlying Workbooks will be in the same folder. The ability to browse and select the files would be nice if this ever changes but if that is too difficult, just indicating the directory path in the Visual Basic code would work. As far as the resultant combined output probably ought to be a new workbook, the filename of the new workbook isn't that important. It could be called combined.xlsx for example.
The following accomplishes the task.
Option Explicit
Private Sub CommandButton1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "c:\test\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
Workbooks.Open (directory & fileName)
WrdArray() = Split(fileName, ".")
For Each sheet In Workbooks(fileName).Worksheets
Workbooks(fileName).ActiveSheet.Name = WrdArray(0)
total = Workbooks("import-sheets.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy after:=Workbooks("import-sheets.xlsm").Worksheets(total)
GoTo exitFor:
Next sheet
exitFor:
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
In Excel press Alt+F11, this will open the Excel VBA editor.
Article http://www.excel-spreadsheet.com/vba/debugging.htm explains some basics how to use it.
In Module1 there are 2 short subroutines opensheets and merge containing ~50 lines of code.
Use F1 with cursor within words you don't understand, to learn what it means.
Once you understand what the code does, you can tailor it to your needs.
I am new to Excel macros.
I have a folder having many files.lets say A,B,C
They all have a worksheet named Summary.
I want a new file named Summary
Which iterates through each file and copies the summary worksheet...into separate worksheet in summary file.
The summary file will hv 3 sheets named A,B, C each having its own summary
First, you'll need a list of files. You can use another spreadsheet to hold the list, or you can scan the directory as follows:
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\temp")
s = ""
For Each fil In fld.Files
s = s & fil.Name & vbCrLf 'a sample of doing something with each fil
'here you can open each workbook using Application.Workbooks.Open
'then, or later, if you like you can close the ones you opened
'by remembering which workbooks were opened before you started.
Next
-- See: http://msdn.microsoft.com/en-us/library/aa242702%28v=vs.60%29
Next, you'll need to create a new workbook, which can be done using
Set newWkb = Application.Workbooks.Add()
-- See: http://msdn.microsoft.com/en-us/library/ff840478.aspx
Now you can use the techniques described by the above posters to copy the worksheet from one workbook to the new one.
For reference, here's some good information on the VBA language. Check out the various Functions, Objects, and Methods, etc.. under the Language Reference: http://msdn.microsoft.com/en-us/library/aa242702%28v=vs.60%29
And here's some good information about the Excel object model: http://msdn.microsoft.com/en-us/library/ff194068