In a quest to further never do anythign manual ever again
I made an it.xlsm that you have to put together in a folder with a specific file that has to be processed.
This it.xslm has three modules:
Masterfile
- renames the categories in C
-makes a worksheet per category in C
-saves those worksheets as .xslx. This results in 8 new files in a /Departement folder
Littlefiles
-renames the categories in E
-makes tabs for each category
-cleans up empty columns.
placeholder
Opens the .xls with the data
Applies Masterfile
Opens all the files created by masterfiles
makes tabs and cleans up empty columns.
Placeholder's code:
Sub OpenBigFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim Lastrow As Long
'open main file, apply masterfile moduke
Set wb = Workbooks.Open(ThisWorkbook.path & "\Depositformulier (Reacties).xlsx")
Call masterfile.total
wb.Close SaveChanges:=True
End Sub
This works fine.
Sub OpenAllFiles()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
myPath = ThisWorkbook.path & "\" & "Departement" & "\"
myFile = Dir(myPath & "*.xlsx")
Do While Len(Filename) > 0
DoEvents
Set wb = Workbooks.Open(myPath & myFile, True, True)
Call LittleFiles.total
wb.Close False
myFile = Dir
Loop
End Sub
Here I find myself in problems. I tried to rewrite it many times, using many examples, but always it seems to be stuck at Set wb = Workbooks.Open(Filename:=myPath & myFile)
What am I doing wrong?
Do you need my Littlefiles code?
Also, in general, is it correct that 'ThisWorkbook' will always refer to the this.xlm,even if in the mean time another workbook is active (this being ActiveWorkbook)?
Thanks a bunch
Here's my attempt, i think this way it'll be harder to go wrong as you will have the full path of the file already stored:
Sub OpenAllFiles()
'create an array
Dim myFiles As Variant
ReDim myFiles(500)
myPath = ThisWorkbook.Path
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
'search for at least 5 files in the folder specified above, add the entire path to the array
While myCount < 5
If Dir(myPath & "*.xlsm") <> "" Then
potentialFileToLoad = Dir(myPath & "*.xlsm")
While potentialFileToLoad <> ""
myFiles(myCount) = myPath & potentialFileToLoad
myCount = myCount + 1
potentialFileToLoad = Dir
Wend
End If
Wend
'change size of array to ammount of files found
ReDim Preserve myFiles(myCount - 1)
For Each ii In myFiles
'(Insert Open, Run code, close code here)
Workbooks.Open (ii), True, True
Call LittleFiles.Total
ActiveWorkbook.Close
Next ii
End Sub
try something similar to this
path = "path2folder" & "\" 'this is fairly important and probably why your code breaks?_
you cant add the backslash like you do above
Filename = Dir(path & "*.xl??")
Do While Len(Filename) > 0
DoEvents
Set wbk = Workbooks.Open(path & Filename, True, True)
'add your code
wbk.Close False
Filename = Dir
Loop
Related
Good afternoon,
I have tried searching different forums to no avail.
I have the below VBA code that will loop through all files in a folder and generate in a msge box the total number of rows of every file looped in that folder.
What I need your help on if possible is generate a summary report.
Ideally
The summary report will show File name and show how many rows with data in column H.
Sub LoopThroughFiles()
Dim folderPath As String
folderPath = ThisWorkbook.Path & "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
For Each sh In wb.Sheets
If Application.CountA(sh.Range("H:H")) > 0 Then
myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row
End If
Next
wb.Close False
Filename = Dir
Set wb = Nothing
Loop
MsgBox myCount
End Sub
You could try opening a "home" workbook where all values are stored. Basically, what you'll need to do is open a new workbook, and during your loop through each of the files, you'll paste the file path and the row count in the new workbook. Hopefully this will help, or at least give you an idea of how to do what you're trying to do. `
Sub LoopThroughFiles()
Dim folderPath As String
Dim summarySheet as Workbook
set summarySheet = workbook.add
folderPath = ThisWorkbook.Path & "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
For Each sh In wb.Sheets
If Application.CountA(sh.Range("H:H")) > 0 Then
myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row
End If
Next
wb.Close False
summarySheet.activate
Range("A:A").insert Shift:=xlDown
Cells(1,1) = Filename
Cells(1,2) = myCount
Filename = Dir
Set wb = Nothing
Loop
MsgBox myCount
End Sub`
I am trying to do a loop to unfilter the column A for all the workbooks (as they are the same, alwyas column A).
I want to show all the cells as the filter romve the empty cells.
I have many of folders ( more than 50) so the loop is very useful and important for the next step of my code.
I have a code that works for one folder:
`Sub unfilterr()
Dim y As Workbook, myfile, FolderPath, path
Dim ws As Excel.Worksheet
Set y = Workbooks.Open("Z:\VBA\Copie de Devis_65 Version
avec G35.xlsx")
With y.Worksheets("Para RF")
If Not y.Worksheets("Para RF").AutoFilter Is Nothing Then
y.Sheets("Para RF").Range("A1").AutoFilter Field:=1
End If
End With
End Sub`
and now trying to do the loop:
`Sub unfilter1()
Dim y As Workbook, myfile, FolderPath, path
Dim ws As Excel.Worksheet
'## Open workbooks first:
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
FolderPath = "Z:\VBA\Test\"
path = FolderPath & "*.xls*"
myfile = Dir(FolderPath & "*.xls*")
Do While myfile <> ""
Set y = Workbooks.Open(path) 'I put path instead of myfile because I have error if I put myfile
Set ws = y.Worksheets("Para RF")
'With ws
If Not ws.AutoFilter Is Nothing Then
y.Sheets("Para RF").Range("A1").AutoFilter Field:=1
End If
'End With
myfile = Dir()
y.Close saveChanges:=True
Loop
MsgBox ("Task Complete")
End Sub
can you please tell what is the problem with this loop!?
I am trying it on 4 workbooks in the test folder! only the first one is unfiltered while the others are not. It seems like the loop is repeting on only the first workbook in the folder.
So with this loop no error message but the result is unsatisfing.
Thank you a lot for your help.
cheers!
The Workbook.Open() method needs a full path and the filename.
Replace
Set y = Workbooks.Open(path)
With
Set y = Workbooks.Open(FolderPath & myfile)
and you should be good to go.
You don't need the path variable.
Edit: I minimized your whole script to the bare minimum to loop through all ".xls" files and open all off them within a folder:
Sub OpenWorkbooks()
Dim y As Workbook
Dim myfile As String
Dim FolderPath As String
FolderPath = "C:\TestDirectory\"
myfile = Dir(FolderPath & "*.xls*")
Do While myfile <> ""
Set y = Workbooks.Open(FolderPath & myfile)
myfile = Dir()
Loop
End Sub
The above opens each Excel file in C:\TestDirectory\ on my machine.
N.b. make sure you have the "\" at the end of the FolderPath variable, otherwise it'll look for C:\TestDirectorySomeFileName.xlsx which is not going to work.
I have a folder with nearly 1000 .csv files. Each of these files contains 2 columns, and I would like to copy only one of these columns and transpose it onto a new workbook. The new workbook will contain all the data from each of these files. The following code is what I have generated:
Sub AllFiles()
Application.EnableCancelKey = xlDisabled
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
folderPath = "J:etc. etc. etc." 'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
Filename = Dir(folderPath & "*.csv")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
wb.Range(Range("B1"), Range("B1").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.Close True
Windows("Compiled.xlsm").Activate
Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
For whatever reason the code does not work and a box pops-up saying "Code execution has been interrupted." Once I hit "Debug" the following line is highlighted:
wb.Range(Range("B1"), Range("B1").End(xlDown)).Select
I am not experienced with VBA at all and I am having trouble troubleshooting this issue. Any idea on what this means and what I can do?
The highlighted line is referring to a range on the workbook that is running the macro as opposed to the range within the workbook you have opened. Try replacing with this:
wb.Range(wb.Range("B1"), wb.Range("B1").End(xlDown)).Select
However I would suggest you avoid using the Select function altogether as it tends to slow down code. I've trimmed the loop a bit to avoid using Select and Activate:
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
wb.Range(wb.Cells(1,"B"), wb.Cells(Rows.Count,"B").End(xlUp)).Copy
Workbooks("Compiled.xlsm").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
wb.Close True
Filename = Dir
Loop
Once you open file file, the active workbook is the book just opened and the active sheet is also established.
Your code fails primarily because of the wb.. (In general you would use a sheet reference instead), but in this case, replace:
wb.Range(Range("B1"), Range("B1").End(xlDown)).Select
with:
Range("B1").End(xlDown)).Select
(You also do not need Select to accomplish a copy/paste)
try with below
Sub AllFiles()
Application.EnableCancelKey = xlDisabled
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
folderPath = "c:\work\test\" 'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
Range("B1:B" & Range("B" & Rows.count).End(xlUp).Row).Copy
Workbooks("Compiled").Worksheets("Sheet1").Range("A" & Range("A" & Rows.count).End(xlUp).Row + 1).PasteSpecial Transpose:=True
Workbooks(Filename).Close True
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
wb.Range(...) will never work since wb is a Workbook object. You need a Worksheet object. Try:
Dim ws As Worksheet
Set ws = wb.Activesheet
ws.Range(ws.Range("B1"), ws.Range("B1").End(xlDown)).Select
Sub LoopOtherRevenue()
Dim MyFile As String
Dim FilePath As String
FilePath = "C:\Users\jdubbaneh002\Desktop\Racetrac Other\"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "Book1.xlsm" Then
Exit Sub
End If
ActiveSheet.Range("A1:B14").Copy
Workbooks.Open (FilePath & MyFile)
ActiveWorkbook.Worksheets("A2) Monthly P&L (Source)").Activate
Range("B746:C759").PasteSpecial xlPasteValues
Application.CutCopyMode = False
ActiveWorkbook.Close
MyFile = Dir
Loop
End Sub
Get a paste special error on line Range("B746:C759").PasteSpecial xlPasteValues
The values are being pasted into a combo box. that is where the error is coming from.
For me it seems like the file path is missing a "\"
FilePath = "C:\Users\jdubbaneh002\Desktop\Racetrac Other"
...
MyFile = Dir(FilePath)
...
If MyFile = "Book1.xlsm" Then
...
Workbooks.Open (FilePath & MyFile)
Correct:
Workbooks.Open (FilePath & "\" & MyFile)
Did you try debugging? Where does it throw the error?
I can see all sorts of issues because you're using ActiveWorkbook after opening the 2nd workbook. Is ActiveWorkbook still pointing at the one where the code is, or is it actually pointing at the one you just opened?
Create & set an as Workbook variable as assign the one the code is in to one, and the workbook you're opening to the other. That will eliminate all confusion.
Try this:
Sub LoopOtherRevenue()
Dim rgCopy as Range
Dim MyFile As String
Dim FilePath As String
Dim wb as Workbook
FilePath = "destination folder\"
MyFile = Dir(FilePath)
Set rgCopy = ActiveSheet.Range("A1:B14")
Do While Len(MyFile) > 0
If MyFile = "Book1.xlsm" Then
Exit Sub
End If
set wb Workbooks.Open(FilePath & "\" & MyFile)
rgCopy.Copy Destination:=wb.Worksheets("A2) Monthly P&L (Source)").Range("B746")
wb.Close
MyFile = Dir
Loop
End Sub
I'm attempting to apply a macro that would copy and paste one specific worksheet (call the title of that worksheet "x") from one workBOOK ("x1") , onto a master workBOOK (call that workBOOK "xmaster"), after it copy and pastes the worksheet from workbook x1 it should also rename the title of the worksheet "x" to cell B3. This should be done before it moves to the next workbook.
It would need to do this for workBOOK x1 through, say, x100. I cannot refer to the workbook by name though, because they are each named a string of text that is in no real sortable method.
This code I know works, copying "x" from "x1" to "xmaster", along with renaming the sheet, and breaking the links, is the following:
Sub CombineCapExFiles()
Sheets("Capital-Projects over 3K").Move After:=Workbooks("CapEx Master File.xlsm").Sheets _
(3)
ActiveSheet.Name = Range("B3").Value
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
Select Case wb.Name
Case ThisWorkbook.Name, "CapEx Master File.xlsm"
' do nothing
Case Else
wb.Close
End Select
Next wb
Application.DisplayAlerts = True
End Sub
The Activate Previous window isn't working, also not sure how to fix that portion of it.
I'm not sure how to build this to loop through all workBOOKs in the directory, however.
Should I use this:?
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xlsm if needed ?
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
'Your code here
strFilename = Dir()
Loop
An additional constraint is that it needs to not run the macro on xmaster (it will have an error because it will not have the sheet "x" which will be renamed from the previous workbooks.)
Thanks!
Matthew
like this?
(not tested)
Option Explicit
Sub LoopFiles()
Dim strDir As String, strFileName As String
Dim wbCopyBook As Workbook
Dim wbNewBook As Workbook
Dim wbname as String
strDir = "C:\"
strFileName = Dir(strDir & "*.xlsx")
Set wbNewBook = Workbooks.Add 'instead of adding a workbook, set = to the name of your master workbook
wbname = ThisWorkbook.FullName
Do While strFileName <> ""
Set wbCopyBook = Workbooks.Open(strDir & strFileName)
If wbCopyBook.FullName <> wbname Then
wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
wbCopyBook.Close False
strFileName = Dir()
Else
strFileName = Dir()
End If
Loop
End Sub
This bit will work to avoid running the macro on xmaster.
xmaster = "filename for xmaster"
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xls*", vbNormal) 'this will get .xls, .xlsx, .xlsm and .xlsb files
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder
Do Until strFilename = ""
If strFileName = xmaster Then ' skip the xmaster file
strFilename = Dir()
End If
'Your code here
strFilename = Dir()
Loop
I can't help on the other part though. I don't see any Activate Previous window part in your code.