I'm new to the site and in need of some help. I've created a Macro within excel to pull the values from certain cells in workbooks within a folder and consolidate that information. The code seems to be working, Except that it's only pulling from about half of the workbooks in the folder. Does anyone know Why it's doing this and how I can fix it?
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "T:\Sales Orders\2017\May\"
MyFile = Dir("T:\Sales Orders\2017\May\")
Do While Len(MyFile) > 0
If MyFile = "maytt.xlsm" Then
Exit Sub
End If
Workbooks.Open ("T:\Sales Orders\2017\May\" & MyFile)
Range("F1:F7").Copy
ActiveWorkbook.Close
ecolumn = Sheet1.Cells(Columns.Count).End(xlToLeft).Offset(0, 1).Column
ActiveSheet.Paste Destination:=Worksheets("Summary").Range(Cells(1, ecolumn), Cells(7, ecolumn))
MyFile = Dir
Loop
End Sub
It looks like you want to skip the file "maytt.xlsm" but what you are actually doing is stopping the whole thing (Then Exit Sub) when that file is reached. To skip the file and continue, do the following modifications to the code:
1- Add a line label before the myFile = Dir statement:
NextFile: ' <---------Add this
MyFile = Dir
Loop
2- Replace Exit Sub with Goto NextFile.
Related
I have 250 different excel files inside a folder (with same layout) with columns A to F. I need to add a new column on column G. The conventional approach would be opening each file and adding new column at G. Is there any simple process using Excel macro or any other tools to get this done?
This link helped me. Following is my solution, which works:
Sub LoopThroughFolder()
Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook
'change the address to suite
MyDir = "C:\Users\dell\Desktop\Folder1\" 'Your Directory
MyFile = Dir(MyDir & "*.xlsx") 'Your excel file extension
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Do While MyFile <> ""
Workbooks.Open (MyFile)
Range("G1").Value = "NewColumn" 'New Column Name
ActiveWorkbook.Save
ActiveWorkbook.Close True
MyFile = Dir()
Loop
End Sub
Yes here's the code for open all excel files in a folder: macro - open all files in a folder
In that loop you can add a new Column to that files
I created a macro in VBA (excel) to open a specific range of a daily file which all have a similar start of the name (9489) followed by a file specific date (DD-MM-YY). The selection is then copied into the masterfile (Masterfile.xlsm), this sub is run for all the files from the directory.
Since today however I keep getting an error named "Run-time error 1004: 9489 150116 Daily Dashboard.xlsx could not be found. Check the spelling of the file name, and verify that the file location is correct."
Why do I get this error? Most importantly, can anybody help me solve this error? I did not change the spelling of the file or the files location!
The code:
Sub LoopThroughDirectory()
Dim Myfile As String
Dim erow
Myfile = Dir("F:\WGD\Dep 408101-Se-DCIFINK-009786\Consolidatie & Regulatory Reporting\Regulatory Reporting\Daily dashboard of Ratios\Test Daily Dashboard\")
Application.DisplayAlerts = False
Do While Len(Myfile) > 0
If Myfile = "Masterfile.xlsm" Then
Exit Sub
End If
Workbooks.Open (Myfile)
Worksheets("Liquidity Reporting").Range("A2:E19").Copy
Windows("Masterfile.xlsm").Activate
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 5))
Workbooks(Myfile).Application.CutCopyMode = False
Workbooks(Myfile).Close SaveChanges:=False
Myfile = Dir
Loop
End Sub
The reason that Excel cannot find the file is that MyFile is just the filename; you need to also include that file path.
This line: ActiveSheet.Paste Destination... will throw an error.
Try to avoid select and activate.
There is no need to size a range when using copy and paste. You just need to target the top left cell of the destination range.
Sub LoopThroughDirectory()
Const FOLDERPATH = "F:\WGD\Dep 408101-Se-DCIFINK-009786\Consolidatie & Regulatory Reporting\Regulatory Reporting\Daily dashboard of Ratios\Test Daily Dashboard\"
Dim Myfile As String
Dim Source As Range, Target As Range
Myfile = Dir(FOLDERPATH)
Application.DisplayAlerts = False
Do While Len(Myfile) > 0
If Myfile <> "Masterfile.xlsm" Then
With Worksheets("Sheet1")
Set Target = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
End With
With Workbooks.Open(FOLDERPATH & Myfile)
Set Source = .Worksheets("Liquidity Reporting").Range("A2:E19")
Source.Copy Destination:=Target
.Close SaveChanges:=False
End With
End If
Myfile = Dir
Loop
End Sub
I was attempting to extract data from other workbooks into a master workbook. All of these workbooks were saved in one folder. Besides, before extracting the data it would check the number of files in the folder. If there is only one file and it is the master workbook then it will stop and exit sub.
However, when I ran the macro it got stuck in the "Do while" loop. Then it says it has a run time error 1004, document may be read-only or encrypted1.
I am sure the path is correct.
Below is my code.
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "Import Info.xlsm" Then
Exit Sub
End If
Workbooks.Open (Filepath & MyFile)
Range("F9,F12,F15,F19,F21").Select
Range("F21").Activate
ActiveWindow.SmallScroll Down:=9
Range("F9,F12,F15,F19,F21,F27,F30,F33,F37").Select
Range("F37").Activate
ActiveWindow.SmallScroll Down:=9
Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41").Select
Range("F41").Activate
ActiveWindow.SmallScroll Down:=-27
Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select
Range("F6").Activate
Selection.Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11))
MyFile = Dir
Loop
End Sub
And my questions are,
I don't know where I went wrong with the "Do while" loop
How to fix the run time 1004 error.
Can someone give me advise? Thanks a lot!
Seems to me you're using the loop to open the files instead of doing it manually yourself. Not sure why the loop got stuck unless you had the MyFile = Dir line missing or commented out at runtime.
#Thomas is mostly right, the 1004 error is happening because the source workbook is being closed too early. However, I was able to paste the values using wkbTarget.worksheets(1).paste but it pasted all cells between F6 through F41 - not what you want.
Additionally, your copy range is 11 rows, 1 column but you're specifying a destination range of 1 row, 11 columns: Cells(erow, 1), Cells(erow, 11) . If that's what you really want, you should use Transpose. Using Cells(#,#) inside Range() also produced 1004 errors, but Cells(#,#).address resolved it.
Here's my take:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim wkbSource as Workbook
Dim wkbTarget as Workbook
Dim erow as single
Dim Filepath As String
Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\"
MyFile = Dir(Filepath)
Set wkbTarget = Workbooks(MyFile) 'Assuming the file is already open
Do While Len(MyFile) > 0
If MyFile = "Import Info.xlsm" Then Goto NextFile 'Skip the file instead of exit the Sub
Set wkbSource = Workbooks.Open (Filepath & MyFile) 'Set a reference to the file being opened
wkbSource.worksheet(1).Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select
Selection.Copy
erow = wkbTarget.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(erow, 1).address)
wkbSource.Close
NextFile:
MyFile = Dir
Loop
End Sub
Thomas's single-line copy+paste technique is nicely concise. You could rearrange the lines of code to use that approach, I just recommend making the Source and Target objects clear.
I have a folder in my Desktop with more or less 2000 csv files. Those files have only 1 "Sheet" but the sheet name varies. The only similar thing is that it starts with the word "Tankard".
In that one sheet, I just need to remove Column A and Save it, for all 2000 files. Its only my 2nd month to explore vba automation at work. I'd appreciate if someone can help me. Thanks in advance.
Script:
Sub Tank()
Dim wb As Workbook
Dim myPath As String
Dim myfile As String
Dim myExtension As String
Dim SheetName As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
SheetName = "Tankard*"
myPath = "\\ph00winfdfs01p\shares\JoeyC\documents\Roaming\Windows\Desktop\Tank\"
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "Tankard*.csv"
'Target Path with Ending Extention
myfile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
For i = 1 To 201
Set wb = Workbooks.Open(Filename:=myPath & myfile)
';;;;;;;;;;;;;;WRITE YOUR CODE HERE
Sheets("SheetName").Select
Columns("A").Select
Selection.Delete
wb.Close SaveChanges:=True
Next i
'Get next file name
myfile = Dir
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Try to understand what's happening. What this sub does at the moment is opening the first workbook that Dir can find, opening it 201 times and deleting the first column of sheet "Sheetname" every time.
Sheets("SheetName").Select
This selects the sheet with the name "Sheetname", not the name with the value that you set the string Sheetname to. If anything, it should be Sheets(Sheetname) but wildcards don't work here anyways.
Now let's look at the process you're trying to achieve.
myfile = Dir(myPath & myExtension)
sets myfile to the first file that matches your pattern ...\Tankard*.csv
Set wb = Workbooks.Open(Filename:=myPath & myfile)
opens the file and now you can access the workbook via wb
To delete the first column on the sheet I would recommend selecting all that stuff but deleting the range directly:
wb.Sheets(1).Columns(1).Delete 'If you want to actually delete the column
wb.Sheets(1).Columns(1).Clear 'If you want to just remove the values
As you can see you don't need the name of the sheet at all. Now save the workbook:
wb.Close SaveChanges:=True
Now you can set myfile to the next filename using Dir:
myfile = Dir
Then repeat that until there are no more files (at that point Dir will return "". The best way to achieve that is to use a While loop, e.g. like this
While myfile <> ""
'Do stuff here
Wend '(While End)
The advantage over a For loop is that you don't need to know the exact number of files in your folder.
I'll leave it up to you to patch that all together.
Sub LoopThroughDecTab()
Dim MyFile As String
Dim erow
Dim FilePath As String
FilePath = "C:"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "Dec Tab Macro.xlsm" Then
Exit Sub
End If
Workbooks.Open (FilePath & MyFile)
ActiveWorkbook.Worksheets("Declaration Analysis (Source)").Activate
Range("H9:H21").Copy
ActiveWorkbook.Close False
'Getting Runtime error PasteSpecialMethod of Range Failed on following line'
ActiveSheet.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True
MyFile = Dir
Loop
End Sub
I have files in a folder, the code loops through the files copies values and then I want those values Transposed into the Active MasterSheet. There are 7 values that need to be pasted, and then it should open the next workbook in folder and repeat the process.
Assuming that you posted your complete code, and simply interjected the 'non-code' message to tell us where your error was, give this a try:
Option Explicit
Sub LoopThroughDecTab()
Dim MyFile As String
Dim erow
Dim FilePath As String
Dim DestWB as Workbook
Dim SourceWB as Workbook
'this way we know the one where the code is running and the destination for our copies
set DestWB = ThisWorkbook
FilePath = "C:"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "Dec Tab Macro.xlsm" Then
Exit Sub
End If
Set SourceWB = Workbooks.Open (FilePath & MyFile)
SourceWB.Worksheets("Declaration Analysis (Source)").Range("H9:H21").Copy
'Move the close to AFTER you do the paste
'NOTE: You may have to make a change here:
DestWB.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True
SourceWB.Close False
MyFile = Dir
Loop
End Sub
If you open two workbooks (A & B) in Excel, copy some cells from A, close A, then try to paste into B, you'll have nothing left to paste - closing A clears the clipboard buffer. I believe the same thing is happening here.
Important Notes:
I've removed all references to ActiveWorkbook - I believe that I've gotten it correct, but I always get a bit lost when using Active*, so I avoid it at all cost. (There are a very few situations where it's the only way to get things done, this isn't one of them.) If I've messed up your source & destinations for the copy, simply reverse the Set statements so you're using them the other way.
I'm not sure where erow and FilePath are getting set, so I'm assuming this wasn't the complete code. The assumption is that they'll still get set somehow.
I've not used the copy/transpose function, so you may well need to include Excel Developers's adjustments, as well.
It's difficult to understand what's the problem without seeing what are you copying, but you can try:
ActiveSheet.Cells(erow, 1).PasteSpecial Transpose:=True
set CopyFromRange = Range("H9:H21")
set CopyToRange = ActiveSheet.Cells(erow,1).Resize(1,13)
CopyToRange.Value = Application.Transpose(CopyFromRange.Value)