I have around 500 timecards. Each timecard is it's own file (.xls workbook). I need a total of cell K5 from all those workbooks. This is a one time thing (every quarter) - I don't need the result to be updated if any of those 500+ timecards change.
It would be great if there was a function that took two parameters - 1) the name of the directory containing the Excel files; 2) the specific cell you want totaled.
After 3.5 hours of searching, the Excel forums haven't helped. I must be using bad keywords, as I can't believe Excel doesn't have such basic functionality. (I did find some stuff if I had multiple worksheets in the same workbook - we would not be able to maintain all those time cards in the same file, and going through and opening all the workbooks at the same time would be very tedious - 500+ double-clicks.)
Thanks.
(Windows XP SP3; Microsoft Office Excel 2003)
This is some code that will prompt for a folder to be selected and then cycle all files in that folder for worksheet name [Worksheetname = "Sheet1"] and [CELL = "K5"] and sum the totals in cell K5.
Hopefully this will get you started. You will need to ensure all files have a valid 'Worksheetname' or insert a test.
Option Explicit
Private Sub ReadFilesinFolder()
'**Opens File Dialog and cycles all files for batch or just single file
Dim objFs As Object, objF As Object, objF1 As Object, objFc As Object
Dim strEndofPath As String, strFilePath As String, strFilename As String
Dim lngCount As Long, Worksheetname As String, CELL As String, objWB As Workbook, objWS As Worksheet
Dim dblTOTAL As Double
Worksheetname = "Sheet1"
CELL = "K5"
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
End
End If
For lngCount = 1 To .SelectedItems.Count
strEndofPath = InStrRev(.SelectedItems(lngCount), "\")
strFilePath = Left(.SelectedItems(lngCount), strEndofPath)
strFilename = Right(.SelectedItems(lngCount), Len(.SelectedItems(lngCount)) - strEndofPath)
Next lngCount
End With
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objF = objFs.GetFolder(strFilePath)
'Batch Import
Set objFc = objF.Files
For Each objF1 In objFc
DoEvents
Set objWB = GetObject(objF1)
Set objWS = objWB.Sheets(Worksheetname)
dblTOTAL = dblTOTAL + objWS.Range(CELL).Value
objWB.Close
Set objWB = Nothing
Next objF1
msgbox dblTOTAL
End Sub
Related
I want to know the number of times a value is repeated, for example 288, and how many values there are in total (every number) in many files with the same format.
For one worksheet I would just use =COUNTIF(F:F;288) and =COUNTA(F:F)
But now I have to do it with more than 30000 xlsx files inside a folder.
My first intent was to merge them into one file like this and then count with this solution, but it stopped after 5279 tabs, I guess for some kind of limitation.
All my files are in the same folder (H:\Macro\positions) and the values are only expected in column F.
There are between 100-600 values per file, around 30000 files.
The operation has to be done just once, I don't mind waiting some hours for it to finish.
How would you do it?
Try the code below and follow the comments - basically the code opens each spreadsheet in the given folder, loops through the sheets in that workbook, runs your COUNTIF formula for each sheet and keeps a record of the total count.
Option Explicit
Sub CheckForValue()
Dim objFso As FileSystemObject '<-- add Microsoft Scripting Runtime as a reference
Dim objFile As File
Dim wbToCheck As Workbook
Dim wsToCheck As Worksheet
Dim strPath As String
Dim varValue As Variant
Dim lngValueCount As Long
Dim lngTotal As Long
Dim wsf As WorksheetFunction
On Error Goto CleanUp
strPath = "H:\Macro\positions"
Set objFso = New FileSystemObject '<-- access to file system
varValue = 288 '<-- value you are looking for
lngTotal = 0 '<-- total count of value you are looking for
Set wsf = Application.WorksheetFunction '<-- shortcut to WorksheetFunction
' iterate files in folder
For Each objFile In objFso.GetFolder(strPath).Files
' only check spreadsheets
If objFile.Type = "Microsoft Excel Worksheet" Then
' get reference to workbook
Set wbToCheck = Workbooks.Open(objFile.Path)
' iterate worksheets
For Each wsToCheck In wbToCheck.Worksheets
' your original formula
lngValueCount = wsf.CountIf(wsToCheck.Range("F:F"), varValue)
' add to total
lngTotal = lngTotal + lngValueCount
Next wsToCheck
' close without saving changes
wbToCheck.Close SaveChanges:=False
End If
Next objFile
' final count of value you are looking for
Debug.Print "Total is: " & lngTotal
CleanUp:
' error handling
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
Set objFile = Nothing
Set objFso = Nothing
End Sub
Based on your comment that The operation has to be done just once, I don't mind waiting some hours for it to finish then the above code will do that, just grinding through sheets checking for the value. If you want to improve the speed you can use the following code before the For loop to help:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
And then afterward turn the settings back (after the CleanUp: statement):
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
I have a directory with 6 sub-folders and ~300 excel workbooks(Growing every day).
Each workbook has multiple formulas (~1200 per workbook) that reference a CSV data dump stored on a server path.
My issue is that excel treats the CSV data dump as "dirty data" and prompts warnings every time a workbook is opened claiming it can't update the links(But when the links are checked, excel then says there's no issue).
In all my research I've found there doesn't seem to be a way to fix this other than replace the datasource with a .xsl file which excel doesn't have any issues referencing.
What I need to do, is perform a find and replace on ~300 workbooks, find the CSV server path inside the formulas and replace it with the new server path for the .xls file.
I've tried "Sobolsoft's Excel Find and Replace" software, but that doesn't seem to want to look inside formulas to replace. I've used "Easy-XL" and "Kutools" both of which only work on open workbooks (Which I could live with, if I had to open 20-50 workbooks at a time, run the find and replace, then open the next batch) but neither of them wanted to work either.
I've used the following macro to unprotect/protect each workbook in the directory which works perfectly
Const cStartFolder = "M:\Transfer\DrillHole_Interaction\4.For_Survey" 'no slash at end
Const cFileFilter = "*.xlsm"
Const cPassword = "" 'use empty quotes if blank
Sub UnprotectAllWorksheets()
Dim i As Long, j As Long, arr() As String, wkb As Workbook, wks As Worksheet
ExtractFolder cStartFolder, arr()
On Error Resume Next
j = -1: j = UBound(arr)
On Error GoTo 0
For i = 0 To j
Set wkb = Workbooks.Open(arr(i), False)
For Each wks In wkb.Worksheets
wks.Protect cPassword, True, True
Next
wkb.Save
wkb.Close
Next
End Sub
Sub ExtractFolder(Folder As String, arr() As String)
Dim i As Long, objFS As Object, objFolder As Object, obj As Object
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(Folder)
For Each obj In objFolder.SubFolders
ExtractFolder obj.Path, arr()
Next
For Each obj In objFolder.Files
If obj.Name Like cFileFilter Then
On Error Resume Next
i = 0: i = UBound(arr) + 1
On Error GoTo 0
ReDim Preserve arr(i)
arr(i) = objFolder.Path & Application.PathSeparator & obj.Name
End If
Next
End Sub
If it would help, I'm also open to copying from a 'Master' workbook and copying the specific range into each other workbook (Copy range to range for each book) but I'm at my wits end and do not know how to proceed.
Any help would be appreciated.
No need to find and replace the csv fullname (path & filename) within all formulas, just change the links source at once within each workbook.
Try this within a loop through all workbooks that need to be changed.
Dim Wbk As Workbook
Application.DisplayAlerts = False
Set Wbk = Workbooks.Open(Filename:="WbkTarget.Fullname", UpdateLinks:=3)
With Wbk
.ChangeLink _
Name:="CsvFile.Fullname", _
NewName:="XlsFile.Fullname", _
Type:=xlExcelLinks
.Save
.Close
End With
Application.DisplayAlerts = True
where:
WbkTarget.Fullname: Path and name of the workbook with the link to be replaced
CsvFile.Fullname: Path and name of the csv file to be replaced
XlsFile.Fullname: Path and name of the xls that replaces the csv file
I've been trying to figure out this subroutine for days. I have read every post about VBA copy-paste on this site and haven't found the answer yet. The concept is so simple but when I run it from a command button, it stops after the copy workbook opens, the copy doesn't execute. When I step through in debug, it works as expected. Does anyone see any obvious errors?
'Must have reference to "Microsoft Scripting Runtime" checked
Dim fso As New FileSystemObject
Dim wsData as Worksheet
Dim stPDFName As String
Dim stFileName As String
Dim stReport As String
Dim WSCopy As Worksheet
Dim FD As Office.FileDialog
Set wsData = ThisWorkbook.Sheets("Sheet1")
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.InitialFileName = "J:\Laboratory\Reports\2015"
FD.Show
stReport = FD.SelectedItems(1)
stFileName = fso.GetFileName(stReport)
stPDFName = Left$(stReport, InStrRev(stReport, ".") - 1) & ".pdf"
If Dir(stPDFName) = "" Then
MsgBox "Matching PDF version of this report does not exist":
Exit Sub
Else
Workbooks.Open (stReport)
For Each WSCopy In Workbooks(stFileName).Worksheets
If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then
WSCopy.Range("A1", "BZ5000").Copy
wsData.Range("E2").PasteSpecial
wsData.Columns.AutoFit
Workbooks(stFileName).Close
Exit For
End If
Next WSCopy
End If
Edit: I believe that I have narrowed down the problem to the line:
If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then
When I step through the routine, the StrComp evaluates properly. If I comment out the If/End If lines, the routine works as expected. I use this line to avoid problems that occur when someone moves or renames a worksheet.
If my suspicion is correct and the macro is getting ahead of itself, this should slow it down enough to execute properly. My best guess is that is is not allowing time for the value in stReport to be set, so I have put a loop there, but you may need to try moving it around. You can test to see where the macro runs away from itself by setting a bunch of breakpoints and seeing which ones allow you to successfully resume the rest of the script after stopping at, and which ones leave it broken.
I'm fairly new to DoEvents myself and I'm aware it can be CPU intensive if not used properly, so save your work before testing this just in case you need to force close.
'Must have reference to "Microsoft Scripting Runtime" checked
Dim fso As New FileSystemObject
Dim wsData as Worksheet
Dim stPDFName As String
Dim stFileName As String
Dim stReport As String
Dim WSCopy As Worksheet
Dim FD As Office.FileDialog
Set wsData = ThisWorkbook.Sheets("Sheet1")
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.InitialFileName = "J:\Laboratory\Reports\2015"
FD.Show
Do Until Not(IsEmpty(stReport))
stReport = FD.SelectedItems(1)
DoEvents
Loop
stFileName = fso.GetFileName(stReport)
stPDFName = Left$(stReport, InStrRev(stReport, ".") - 1) & ".pdf"
If Dir(stPDFName) = "" Then
MsgBox "Matching PDF version of this report does not exist":
Exit Sub
Else
Workbooks.Open (stReport)
For Each WSCopy In Workbooks(stFileName).Worksheets
If StrComp(WSCopy.CodeName, "Sheet1", vbTextCompare) = 0 Then
WSCopy.Range("A1", "BZ5000").Copy
wsData.Range("E2").PasteSpecial
wsData.Columns.AutoFit
Workbooks(stFileName).Close
Exit For
End If
Next WSCopy
End If
I've created a VBA macro and need to perform the same tasks on multiple different files. Ideally i'd like to create a button on my Ribbon and execute the tasks with the click of a button. How do I make the macro available to multiple files and execute the tasks using the data from a newly opened worksheet? I've added the macro to a PERSONALS.xlsb file and can see the macro available every time I open Excel, but the macro only executes the tasks on the PERSONALS.xlsb file, not the newly opened file.
Sub Export_Files()
Dim sExportFolder, sFN
Dim rDiscription As Range
Dim rHTMLcode As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object
'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "C:\Users\bhinton\Desktop\ActionTags"
Set oSh = Sheet1
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rDiscription In oSh.UsedRange.Columns("C").Cells
Set rHTMLcode = rDiscription.Offset(, 6)
'Add .txt to the article name as a file name
sFN = rDiscription.Value & ".html"
Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
oTxt.Write rHTMLcode.Value
oTxt.Close
Next
End Sub
Instead of
Set oSh = Sheet1
You need to use
Set oSh = ActiveSheet
Using ActiveSheet means that the code will use the newly opened workbook and the active sheet which I think is what you want.
Or if you always want Sheet1 of the currently active workbook, you can do this:
Set oSh = ActiveWorkbook.Worksheets("Sheet1")
Here's one way to prompt the user to select files then iterate through them:
Option Explicit
Sub OpenFilesAndIterate()
Dim DataDialog As FileDialog
Dim NumFiles As Long, Counter As Long
Dim MyWorkbook As Workbook
Dim MySheet As Worksheet
'prompt the user to select data files
Set DataDialog = Application.FileDialog(msoFileDialogOpen)
With DataDialog
.AllowMultiSelect = True
.Title = "Please pick the files you'd like to operate on:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
'assign the number of files selected for an easy loop boundary
NumFiles = DataDialog.SelectedItems.Count
'check to see if the user clicked cancel
If NumFiles = 0 Then Exit Sub
'Start looping through and do work
For Counter = 1 To NumFiles
Set MyWorkbook = Workbooks.Open(DataDialog.SelectedItems(Counter))
Set MySheet = MyWorkbook.Worksheets("Sheet1")
'
'insert your code to operate on worksheet here
'
MyWorkbook.Save
MyWorkbook.Close SaveChanges:=False
Next Counter
End Sub
In the options for Excel, click on Customize Ribbon. Above the list of things you can add there should be a dropdown box where you can select Macros. The list should then be populated with macros to add to your ribbon!
I want to collect data from different files and insert it into a workbook doing something like this.
Do While THAT_DIFFERENT_FILE_SOMEWHERE_ON_MY_HDD.Cells(Rand, 1).Value <> "" And Rand < 65536
then 'I will search if the last row in my main worksheet is in this file...
End Loop
If the last row from my main worksheet is in the file, I'll quit the While Loop. If not, I'll copy everything. I'm having trouble finding the right algorithm for this.
My problem is that I don't know how to access different workbooks.
The best (and easiest) way to copy data from a workbook to another is to use the object model of Excel.
Option Explicit
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet2").Range("C3:D4").Value = wb.Worksheets("Sheet1").Range("A1:B2").Value
End Sub
You might like the function GetInfoFromClosedFile()
Edit: Since the above link does not seem to work anymore, I am adding alternate link 1 and alternate link 2 + code:
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""
If Dir(wbPath & "" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
Are you looking for the syntax to open them:
Dim wkbk As Workbook
Set wkbk = Workbooks.Open("C:\MyDirectory\mysheet.xlsx")
Then, you can use wkbk.Sheets(1).Range("3:3") (or whatever you need)
There's very little reason not to open multiple workbooks in Excel. Key lines of code are:
Application.EnableEvents = False
Application.ScreenUpdating = False
...then you won't see anything whilst the code runs, and no code will run that is associated with the opening of the second workbook. Then there are...
Application.DisplayAlerts = False
Application.Calculation = xlManual
...so as to stop you getting pop-up messages associated with the content of the second file, and to avoid any slow re-calculations. Ensure you set back to True/xlAutomatic at end of your programming
If opening the second workbook is not going to cause performance issues, you may as well do it. In fact, having the second workbook open will make it very beneficial when attempting to debug your code if some of the secondary files do not conform to the expected format
Here is some expert guidance on using multiple Excel files that gives an overview of the different methods available for referencing data
An extension question would be how to cycle through multiple files contained in the same folder. You can use the Windows folder picker using:
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .Selected.Items.Count = 1 the InputFolder = .SelectedItems(1)
End With
FName = VBA.Dir(InputFolder)
Do While FName <> ""
'''Do function here
FName = VBA.Dir()
Loop
Hopefully some of the above will be of use
I had the same question but applying the provided solutions changed the file to write in. Once I selected the new excel file, I was also writing in that file and not in my original file. My solution for this issue is below:
Sub GetData()
Dim excelapp As Application
Dim source As Workbook
Dim srcSH1 As Worksheet
Dim sh As Worksheet
Dim path As String
Dim nmr As Long
Dim i As Long
nmr = 20
Set excelapp = New Application
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.Show
path = .SelectedItems.Item(1)
End With
Set source = excelapp.Workbooks.Open(path)
Set srcSH1 = source.Worksheets("Sheet1")
Set sh = Sheets("Sheet1")
For i = 1 To nmr
sh.Cells(i, "A").Value = srcSH1.Cells(i, "A").Value
Next i
End Sub
With excelapp a new application will be called. The with block sets the path for the external file. Finally, I set the external Workbook with source and srcSH1 as a Worksheet within the external sheet.