I'm trying to implement a command button in my excel sheet that will prompt the user to select the files he wants to load before loading the selected files into the specified cells. So far I have tried using the following code but to no avail. I have been getting a type 13 error
Sub check11()
Dim FileName() As Variant
Dim f As String
Dim i As Variant
Dim j As Variant
Dim rng As Variant
rng = ActiveCell.Address
f = Application.GetOpenFilename("TXT File (*.txt), *.txt")
For i = 0 To 1
FileName(f) = j
Range(rng).Value = j
ActiveCell.Offset(1, 0).Select
Next i
End Sub
GetOpenFileName doesn't work in the way you have coded it. You can't select multiple files (as far as I'm aware) so the loop you run is redundant. The function will return either False if the user hits Cancel or the name of the file as a string. You ought to test for the Cancel case within your code.
I can't see the purpose of your loop or why you're selecting the offset cell. I think it might be a development error so I've just disregarded it.
Below is some code that shows you how the GetOpenFileName function could work in your context:
Sub check11()
Const TARGET_COL As String = "A" 'adjust letter for your column
Dim ws As Worksheet
Dim selectedFile As Variant
Dim cell As Range
'Find the next blank cell in target column
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set cell = ws.Cells(ws.Rows.Count, TARGET_COL).End(xlUp).Offset(1)
'Open the file dialog window
selectedFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
'Check if user hit cancel
If selectedFile = False Then Exit Sub
'Write the file name
cell.Value = selectedFile
End Sub
You have inccorect acces to Application.GetOpenFilename first of all you need to set MultiSelect to true so you will be able to select multiple files. Then this function will return array which you can loop. In loop i spliting filepath by "\" and with knowledge that filename is always last, i just write filename into cell.
Sub check11()
Dim filePath() As Variant
Dim i As Long
filePath = Application.GetOpenFilename("TXT File (*.txt), *.txt", MultiSelect:=True)
For i = 1 To UBound(filePath)
Sheets("Sheet2").Cells(1 + i, 1).Value = Split(filePath(i), "\")(UBound(Split(filePath(i), "\")))
Next i
End Sub
Related
I have a workbook with different modules, each with a different purpose.
What the code does:
The first module opens a FileDialog box that requires the user to select the path where the source files (.csv) are, then it searches and pastes the names of each source file into the main workbook.
The second module reads the file names and using the "pathS" variable; from the first module, gets the information from the source workbooks.
The third module cleans all the information and outputs it to new workbooks.
What I already tried: The variable pathS is defined in the first module as the location of the source files, and it is then used in module 2 to locate the files (for info extraction). I declared it as public in module 1, outside the sub.
The Problem: When I run the module 2, it cannot find the source files.
Question: Is there anything wrong with the way I am using the variable?
Relevant Code:
Module 1:
Option Explicit
Global pathS As String
Sub Counter()
Dim count As Integer, i As Long, var As Integer
Dim ws As Worksheet
Dim w As Workbook
Dim Filename As String
Dim FileTypeUserForm As UserForm
Dim x As String
Dim varResult As Variant
Dim OutPath As String, OutPathS As String, wPos As Long
Set w = ThisWorkbook
Application.Calculation = xlCalculationManual
'source input by user
varResult = Application.GetSaveAsFilename(FileFilter:="Comma Separated Values Files" & "(*.csv), *.csv", Title:="OutPath", InitialFileName:="D:StartingPath")
If varResult <> False Then
OutPath = varResult
w.Worksheets("FILES").Cells(1, 4) = varResult
Else
Exit Sub
End If
wPos = InStr(OutPath, "\StartingPath")
OutPathS = Mid(OutPath, 1, wPos - 1)
pathS = OutPathS & "\*.*"
Filename = Dir(pathS)
ThisWorkbook.Sheets("FILES").Range("A:A").ClearContents
x = GetValue
If x = "EndProcess" Then Exit Sub
Set ws = ThisWorkbook.Sheets("FILES")
i = 0
Do While Filename <> ""
var = InStr(Filename, x)
If var <> 0 Then
i = i + 1
ws.Cells(i + 1, 1) = Filename
Filename = Dir()
Else: Filename = Dir()
End If
Loop
Range("A2:A" & i).Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlNo 'this will sort the names directly in the "FILES" sheet
Application.Calculation = xlCalculationAutomatic
ws.Cells(1, 2) = i
MsgBox i & " : files found in folder"
End Sub
Module 2 (only until the error line):
Sub Gatherer()
Dim w As Workbook
Dim w2 As Workbook
Dim start1 As Long, end1 As Long, end2 As Long, i As Long, lRow As Long, lColumn As Long, t As Long, k As Long, position As Long, g As Long, C As Long
Dim WBArray() As Variant
Dim Cell As Range
Dim ws As Worksheet
Dim MyFolder As String
Dim MyFile As String
Set w = ThisWorkbook
'clean all worksheets in the main file (except FILES), and set date format
For Each ws In w.Worksheets
If ws.Name <> "FILES" Then
ws.UsedRange.ClearContents
ws.Range("D1", "XFD1").NumberFormat = "yyyy-mm-dd"
End If
Next ws
'Optimize Macro Speed Start
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'opens the first workbook file
For i = 2 To ThisWorkbook.Sheets("FILES").Cells(1, 2).Value + 1 'has to be +1, otherwise the last source file is not accounted for
'error is in this next line, it does not find the file
Workbooks.Open Filename:=pathS & ThisWorkbook.Sheets("FILES").Cells(i, 1).Value
You can prefix the module name to the variable to be sure about which varaiable you are trying to access and also whether you have access to it.
Example works fine:
Module1
Option Explicit
Public foo As String
Sub Test1()
Module1.foo = "bar"
Module2.Test2
End Sub
Module2
Option Explicit
Sub Test2()
MsgBox Module1.foo
End Sub
(Previous Post)
I need to create a macro that loops through the files that are in a single folder and runs the code that I have provided below. All the files are structured the same way however, have different data. The code helps me go to a specified destination file and counts the number of "YES" in the column. Then it outputs it into a CountResults.xlsm (master workbook). I have the following code with the help of Zac:
Private Sub CommandButton1_Click()
Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("C:\Users\khanr1\Desktop\CodeUpdateTest\Test01.xlsx")
Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2")
ThisWorkbook.Worksheets("Sheet1").Range("B2").Value = Application.WorksheetFunction.CountIf(oWS.Range("B:B"), "YES")
oWBWithColumn.Close False
Set oWS = Nothing
Set oWBWithColumn = Nothing
End Sub
This is what the CountResults.xlsm (Master Workbook) looks like:
And, this is an example of what the Test01.xlsx looks like:
To note, there are 10 test files (Test01, Test02...) but the code should be able to update any new test files added (ex. Test11, Test12...). I had an idea of incorporating the "Files" column in the first image to pull the file names and loop them.
The easiest way to do so would be to use the filesystemobject to loop through all the files in the folder and find the ones where filename is similar to the predetrmined mask( in your case "Test*.xslx"). Please note that it also goes through subfolders in the specified folder. If that is not required, omit the first for each loop:
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim oWBWithColumn As Workbook
Dim oWbMaster as workbook
Dim oWsSource as worksheet
Dim oWsTarget as worksheet
Dim Mask As String
Dim k as long
k=2
Set oWbMaster = ActiveWorkbook
Set oWsTarget = oWbMaster.Sheets("Sheet1")
Set fso = CreateObject("scripting.FileSystemObject")
Set fldStart = fso.GetFolder("C:\Users\khanr1\Desktop\CodeUpdateTest\")
Mask = "Test*" & ".xlsx"
For Each fld In fldStart.Subfolders
For Each fl In fld.Files
If fl.Name Like Mask Then
Set oWBWithColumn = Application.Workbooks.Open(Filename:=fld.Path & "\" & fl.Name, ReadOnly:=True)
Set oWsSource = oWBWithColumn.Worksheets("Sheet2")
oWsTarget.Range("B"& k).Value = Application.WorksheetFunction.CountIf(oWsSource.Range("B:B"), "YES")
oWBWithColumn.Close SaveChanges:=False
k = k+1
End If
Next
Next
If this answer helps, please mark as accepted. Also note that your original code would replace the value of B2 cell in the master spreadsheet every iteration of the loop, that's why I have added the k variable to change the target cell after each iteration
P.S.
You can generate a list of files along with the yes counts from the folder all at the same time, just add this line to the code before closing the file:
oWsTarget.Range("A"& k).Value= fl.Name
The easiest thing to do is convert your code into a function.
Private Sub CommandButton1_Click()
Dim r As Range
With Worksheets("Sheet1")
For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
r.Offset(0, 1).Value = getYesCount(r.Value)
Next
End With
End Sub
Function getYesCount(WorkBookName As String) As Long
Const FolderPath As String = "C:\Users\khanr1\Desktop\CodeUpdateTest\"
If Len(Dir(FolderPath & WorkBookName)) Then
With Workbooks.Open(FolderPath & WorkBookName)
With .Worksheets("Sheet2")
getYesCount = Application.CountIf(.Range("B:B"), "YES")
End With
.Close False
End With
Else
Debug.Print FolderPath & WorkBookName; ": Not Found"
End If
End Function
I have many Excel documents (containing about a page of information, A-H columns and 1-25rows give or take a few) in a folder titled "Progress".
In one Excel document, I am trying to search for a particular column title "Tool Cutter" and take everything listed in that column, copy it, and output it to a separate spreadsheet (all of the tools are separated by a semicolon if that helps at all).
I am trying to write a program which goes into the "Progress" folder and will loop through opening each file, copying the "Tool Cutter" values I need, outputing it to a separate Excel spreadsheet I've titled "MasterList.xlsm", closing the file, and working through all of the files in that folder until there are none left.
It would be helpful if the "MasterList.xlsm" file could have Name in column 1 and Tools in column 2.
Any advice would be very helpful! I am not an expert in VBA.
What I have been trying:
Methods with AdvancedFilter, CopyToRange, SearchString...
All of the information I am trying to grab is in a column between titles "tools" and "general setup" so this code has been somewhat helpful:
Sub LoopThroughDirectory()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim MyFolder As String
Dim Sht As Worksheet
Dim i As Integer
Dim LastRow As Integer, erow As Integer
'Speed up process by not updating the screen
'Application.ScreenUpdating = False
MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
Set Sht = ActiveSheet
'create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'get the folder object
Set objFolder = objFSO.GetFolder(MyFolder)
i = 1
'loop through directory file and print names
For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, 3)) <> "xls" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
Else
'print file name
Sht.Cells(i + 1, 1) = objFile.Name
i = i + 1
Workbooks.Open fileName:=MyFolder & objFile.Name
End If
'Range("J1").Select
'Selection.Copy
'Windows("masterfile.xlsm").Activate
'Range("D2").Select
'ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=False
Next objFile
'Application.ScreenUpdating = True
End Sub
**The document (image attached) is not formatted them same way every time, depending on the info available sometimes column number or row number is different.
I would use this to get the last row/column - much faster than looping:
Function getLastRow(sheet As String, Col As Variant) As Integer
getLastRow = Sheets(sheet).Cells(Sheets(sheet).Rows.Count, Col).End(xlUp).Row
End Function
Function getLastCol(sheet As String, row As Variant) As Integer
getLastCol = Sheets(sheet).Cells(row, Sheets(sheet).Columns.Count).End(xlToLeft).Column
End Function
The full version of these functions lets you specify the workbook to check
(which is important when you are opening multiple workbooks like you plan to)
Function GetLastCol(Row As Variant, Optional Sheet As String, Optional WB As Variant) As Integer
If IsMissing(WB) Then
If Sheet = vbNullString Then
GetLastCol = Cells(Row, Columns.Count).End(xlToLeft).Column
Else
GetLastCol = Sheets(Sheet).Cells(Row, Sheets(Sheet).Columns.Count).End(xlToLeft).Column
End If
Else
If Sheet = vbNullString Then
GetLastCol = WB.ActiveSheet.Cells(Row, WB.ActiveSheet.Columns.Count).End(xlToLeft).Column
Else
GetLastCol = WB.Sheets(Sheet).Cells(Row, WB.Sheets(Sheet).Columns.Count).End(xlToLeft).Column
End If
End If
End Function
Function GetLastRow(Col As Variant, Optional Sheet As String, Optional WB As Variant) As Integer
If IsMissing(WB) Then
If Sheet = vbNullString Then
GetLastRow = Cells(Rows.Count, Col).End(xlUp).Row
Else
GetLastRow = Sheets(Sheet).Cells(Sheets(Sheet).Rows.Count, Col).End(xlUp).Row
End If
Else
If Sheet = vbNullString Then
GetLastRow = WB.ActiveSheet.Cells(WB.ActiveSheet.Rows.Count, Col).End(xlUp).Row
Else
GetLastRow = WB.Sheets(Sheet).Cells(WB.Sheets(Sheet).Rows.Count, Col).End(xlUp).Row
End If
End If
End Function
If you have a square block of data like most excel sheets, you can also use:
ActiveSheet.UsedRange.Rows.Count
ActiveSheet.UsedRange.Columns.Count
The benefit of using these functions is that you can use it like:
Range("A1:A" & GetLastRow("A"))
The rest of your find code looks okay.
Here is a function to find all files in a folder.
It returns a collection of path names that you can iterate through using a For Each loop as demonstrated below:
Private Function GetFiles(Path As String, Optional Extension As String = "*") As Collection
Dim objFSO As Object
Dim FilesReturned As Collection
Set FilesReturned = New Collection
Dim Files, File
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set Files = objFSO.GetFolder(Path).Files
On Error GoTo 0
If Files Is Nothing Then Exit Function
For Each File In Files
If UCase(objFSO.GetExtensionName(Path & File.Name)) Like UCase(Replace(Extension, ".", "")) Then
FilesReturned.Add (Path & IIf(Right(Path, 1) = "\", "", "\") & File.Name)
End If
Next File
Set GetFiles = FilesReturned
End Function
You can use this with a For Each loop to loop through each workbook.
You can open them using Workbooks.Open and use your find code like so:
(This code should go in the master sheet)
Sub GetTools()
Dim Files as Collection
On Error Resume Next
Set Files = GetFiles("C:\OurPath")
On Error GoTo 0
If Files Is Nothing Then
MsgBox ("No Files Found!")
Exit Sub
End If
'You can also use this to specify the extension if there are other types:
'Set Files = GetFiles("C:\OurPath","xls")
Dim ThisWb as Workbook
Set ThisWb = ThisWorkbook
Application.ScreenUpdating = False
For Each File In Files
Workbooks.Open File, ReadOnly:=True
'Add code to find things and copy
'We can use this line to copy from the Open Workbook, Sheet1, Range A2-A[Lastrow]
ActiveWorkbook.Sheets("Sheet1").Range("A2:A" & GetLastRow("A","Sheet1")).Copy _
ThisWb.Sheets("Sheet1").Range("A" & GetLastRow("A","Sheet1",ThisWb) + 1)
'to the bottom of our Master Sheet, column A
ActiveWorkbook.Close SaveChanges:=False
Next File
Application.ScreenUpdating = True
End Sub
Testing
I have the following files in a directory:
Tools1.xls: Tools2.xlsx":
When I run the macro on my "Master":
I am left with these results:
Edit:
If you want to add a function to your code, treat it as a separate subroutine.
For example:
Sub DoThings()
For x = 1 to 10
MsgBox(getLastRow("Sheet1",x))
Next x
End Sub
Function getLastRow(sheet As String, Col As Variant) As Integer
getLastRow = Sheets(sheet).Cells(Sheets(sheet).Rows.Count, Col).End(xlUp).Row
End Function
I have been attempting to insert a VLookup formula into a column using VBA. The Table_array is variable and changes each month, so I would like a dialog box to specify the file I want to use. The Table_array is in an identical format each month and my formula so far is as follows:
Sub VlookupMacro()
Dim FirstRow As Long
Dim FinalRow As Long
Dim myValues As Range
Dim myResults As Range
Dim myFile As Range
Dim myCount As Integer
Set myFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
Set myValues = Application.InputBox("Please select the first cell in the column with the values that you're looking for", Type:=8)
Set myResults = Application.InputBox("Please select the first cell where you want your lookup results to start ", Type:=8)
Range(myResults, myResults.Offset(FinalRow - FirstRow)).Formula = _
"=VLOOKUP(" & Cells(FirstRow, myValues.Column) & ", myFile.value($A$2:$B$U20000), 5, False)"
If MsgBox("Do you want to convert to values?", vbYesNo) = vbNo Then Exit Sub
Columns(myResults.Column).Copy
Columns(myResults.Column).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
I'm getting an issue with 'myFile' at the moment where the code doesn't proceed past the Set = myFile line. Any suggestions or amendments would be most welcome. Other than that the variable file will never be longer than 20000 lines (which is why I have fixed the range in the formula) and we will always pick up column 5.
GetOpenFileName will not return an Object. Hence, you can't Set the value.
Try:
FileName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
If FileName = False Then
' User pressed Cancel
MsgBox "Please select a file"
Exit Sub
Else
Workbooks.Open Filename:=FileName
End If
You've declared MyFile as a range, but you're attempting to put a filename in the var. The GetOpenFileName function returns the filename, but doesn't open the file. You'll have to save the filename to a string variable, then open the workbook using that filename.
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.