Say I have the following path and file name:
P:\...\Annual and Quarterly Budget Data\ECMQA 2012Q1.xls
I want to write an if then statement that does the following (not sure if my statement is set up properly):
If InStr(1, "P:\...\Annual and Quarterly Budget Data\ECMQA 2012Q1.xls", "QA", vbTextCompare) > 0 Then
BD.Sheets("Sheet1").Range("C2").value = "2012Q1"
End If
Instead of just inputting "2012Q1", I want it to automatically read this from the file. The thing is I am actually looping through 12 or so files and there's two types, "ECMQA 2012Q1.xls" (or ECMQB 2012Q2.xls and so on) AND "ECM Annual Budget 2012.xlsx"
If my file is the annual one (If file contains "Annual"), then I want:
BD.Sheets("Sheet1").Range("C2").value = "2012"
And i want it to read this from the actual file, same as the other one...not me putting in "2012"
Is there a way to do this?
Any help will be appreciated!
EDIT:
Here is the loop:
Dim wb As Workbook, sFile As String, sPath As String
Dim itm As Variant
Dim strFileNames As String
sPath = "C:\Actuary\Cash Flow Forecast\Annual and Quarterly Budget Data\"
''Retrieve the current files in directory
sFile = Dir(sPath)
Do While sFile <> ""
strFileNames = strFileNames & "," & sFile
sFile = Dir()
Loop
''Open each file found
For Each itm In Split(strFileNames, ",")
If itm <> "" Then
Set wb = Workbooks.Open(sPath & itm)
''DO LOTS OF CALCULATIONS
'wb.Close True
End If
Next itm
Filesystemobject has a method for extracting the base name from a filename:
Msgbox createobject("scripting.filesystemobject").getbasename("myTest.xlsx") 'myTest
There's lots of ways to get at what you need using split, right, left, mid, or even regex. It really depends on the makeup of the possible source strings and how much variation they contain.
Based soley on your example the following shows various manipulations with the last variable giving "2012"
Sub test()
fPath = "P:\...\Annual and Quarterly Budget Data\ECMQA 2012Q1.xls"
fArray = Split(fPath, "\")
fnamewithtext = fArray(UBound(fArray))
fnamewithoutext = Split(fArray(UBound(fArray)), ".")(0)
ifannual = Left(Split(fArray(UBound(fArray)), " ")(1), 4)
End Sub
Related
I have a xlsm that amonst others runs through all .xslx files in a directory, runs a sub, saves them. (Thank you Tabias)
inside this sub I am now trying to add something that would add the last column from a third file.
My first problem here is how to define the sourcefile. We need to take data from the exact file, with a similar name. So MC.xslx ahs to copy from MC12february.xlsx and KA.xlsx has to import from KAwhateverdate.xlsx
Set wbA = Workbooks.Open("C:\files" & "\" & ActiveWorkbook.Name & "*.xlsx")
unfortunately, active.workbook.name includes the extention, so OR you guys can tell me a solution OR i have to save the files date+name first and change it into wbA = Workbooks.Open("C:\files" & "\*" & ActiveWorkbook.Name) right?
The same goes for the sheet. Those wil, depending on the file, be called MC, KA,KC,...
Next since i only want to copy the last column of the file into the last column of the other file I'm quite confused. I found this code and thought it was the most understandable.
Sub import()
Dim Range_to_Copy As Range
Dim Range_Destination As Range
Dim Sheet_Data As Worksheet 'sheet from where we pull the data
Dim Sheet_Destination As Worksheet ' destination
Dim workbook_data As Workbook
Dim workbook_destination As Workbook
Set workbook_data = "N:\blah\deposit" & "\*" & ActiveWorkbook.Name
Set workbook_detination = ActiveWorkbook
Set Sheet_Data = ThisWorkbook.Sheets("Sheet1") 'help, how do i do this?
Set Sheet_Destination = ThisWorkbook.Sheets("Sheet1") ' and this?
Set Range_to_Copy = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
Set Range_Destination = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
Range_to_Copy.Copy Range_Destination 'this copies from range A to B (basically A.copy B), but i changed variable names to make it easier...
'you can simplify without variables like this:
'Sheets("Sheet1").Range("D1").Copy Sheets("Summary).Range("A1") <===== does the same as the above coding
None of the more simpler solutions seemed fit either. example
As you see I'm completely stuck at how to define the last column and the name of the sheet. This code is to uncomplete for me to check by doing. Can someone put me on the right path? thank you.
As a supplement, I'd suggest creating a simeple, re-usable file open functions where you can provide a filename as a String that you'd like to search for. The function will loop through a directory (as Batman suggested) and, optionally, pull the most recent version (using date modified) of that file. Below is a set of functions that I use frequently. There is a subfolder parameter `subF' that will allow you to search within subfolder(s) relative to the current file location.
'FUNCTION opnWB
'--Opens a workbook based on filename parameter
'----WILDCARDS before and after the filename are used to allow for filename flexibility
'----Subfolder is an OPTIONAL PARAMETER used if the location of the file is located in a subfolder
Public Function opnWB(ByVal flNM As String, Optional ByVal subF As String = "") As Workbook
If subF <> "" Then subF = "\" & subF
Dim pthWB As String
pthWB = "\*" & flNM & "*" 'wildcard characters before and after filename
pthWB = filePull(subF, pthWB)
Set opnWB = Workbooks.Open(ActiveWorkbook.path & subF & "\" & pthWB, UpdateLinks:=0)
End Function
'FUNCTION filePull
'--Cycles through folder for files that match the filename parameter (with WILDCARDS)
'--If there is more than one file that matches the filename criteria (with WILDCARDS),
'----the file "Date Modified" attribute is used and the most recent file is "selected"
Private Function filePull(ByVal subF As String, ByVal path As String) As String
Dim lDate, temp As Date
Dim rtrnFl, curFile As String
Filename = Dir(ActiveWorkbook.path & subF & path)
Do While Filename <> ""
curFile = Filename
curFile = ActiveWorkbook.path & subF & "\" & Filename
If lDate = 0 Then
rtrnFl = Filename
lDate = GetModDate(curFile)
Else
temp = GetModDate(curFile)
End If
If temp > lDate Then
rtrnFl = Filename
lDate = temp
End If
Filename = Dir()
Loop
filePull = rtrnFl
End Function
'FUNCTION GetModDate
'--Returns the date a file was last modified
Public Function GetModDate(ByVal filePath As String) As Date
GetModDate = CreateObject("Scripting.FileSystemObject").GetFile(filePath).DateLastModified
End Function
You could tweak this method where the filename would have to start file the String you pass in by simply removing the wildcard character before flNM. To use, you would simply call the opnWB function, passing in "MC" or whatever general file name you'd like to open:
Dim wbTarMC as Workbook
Set wbMC = opnWB("MC", "Source Files") 'this would open up MC.xlsx file within the subfolder "Source Files" (relative to current file location)
Hope this helps.
All - I am looking to write a loop where I can change the filename and folder location depending on the value that it runs in the loop. For example, if I am running the macro from cells G2:G7, when the process moves from G2 to G3, I want the filename and folder location to change according to some reference table (look image for details). Effectively, I want the filename and foldername to be lookups to the Fund Types.
Public Sub Get_File()
Dim sFiletype As String
Dim sFilename As String 'Save the file as this name, if "" then default
Dim sFolder As String 'Save to this folder, if "" then default
Dim bReplace As Boolean 'To replace the existing file or not
Dim sURL As String 'The URL to the location to extract information
Dim cell, Rng As Range
Dim sheet As Worksheet
'Initialize variables
Set Rng = Range("I2:I10")
Set sheet = ActiveWorkbook.Sheets("Macro_Button")
For Each cell In Rng
If cell <> "" Then
sFiletype = cell.Value
sFilename = sFiletype & "_" & Format(Date, "mmddyyyy")
sFolder = Application.WorksheetFunction.VLookup(sFiletype, sheet.Range("G2:J10"), 4, False)
bReplace = True
sURL = "www.preqin.com"
'Download using the desired approach, XMLHTTP / IE
Call Download_Use_IE(sURL, sFilename, sFolder, bReplace)
Else
Exit Sub
End If
Next
End Sub
Thanks everyone for your input!
http://i.stack.imgur.com/M6GSs.png
Therein lies the limitation of VLookUp where matches must align to the leftmost column and only searches to the right. As advised in the popular web search, consider an Index/Match replacement which compares column to column and returns value on matched row (in any direction):
sFolder = Application.WorksheetFunction.Index(sheet.Range("G2:J10"), _
Application.WorksheetFunction.Match(sFiletype, sheet.Range("I2:I10"), 0), 4)
If needing to use VLookUp(), you would need to decrease your lookup range:
sFolder = Application.WorksheetFunction.VLookup(sFiletype, sheet.Range("I2:J10"), 2, False)
Instead of vlookup, I suggest placing the exact folders into the code given that you only have 8 choices. This makes it readily obvious for debugging. You can do this via a case statement. See here for more information.
Select Case sFilename
Case abc
sFolder = "C:\One\"
Case def
sFolder = "C:\Two\"
Case ghi
sFolder = "C:\Three\"
'so forth for 8 cases...
End Select
As we know, we use Find() method to find whether a string or any Microsoft Excel data type exists in an excel.
(Usually we do it on set of data)
I want to know if any such method available when we loop through folder(of files) using Dir function.
Situation:
I have an excel - 'FileNames.xlsx' in which 'Sheet1' has names of files having extensions .pdf/.jpg/.jpeg/.xls/.xlsx/.png./.txt/.docx/ .rtf in column A.
I have a folder named 'Folder' which has most(or all) of the files from 'FileNames.xlsx'.
I have to check whether all the file-names mentioned in the 'FileNames.xlsx' exist in 'Folder'.
For this I have written the below VBScript(.vbs):
strMessage =Inputbox("Enter No. of Files in Folder","Input Required")
set xlinput = createobject("excel.application")
set wb123 =xlinput.workbooks.Open("E:\FileNames.xlsx")
set sh1 =wb123.worksheets("Sheet1")
For i = 2 to strMessage +1
namei = sh1.cells(i,1).value
yesi = "E:\Folder"+ namei +
If namei <> yesi Then
sh1.cells(i,1).Interior.Color = vbRed
Else
End If
Next
msgbox "Success"
xlinput.quit
As I wasn't able to get the required Output I tried it recording a small Excel VBA Macro. (Changed FileNames.xlsx to FileNames.xlsm)
Sub LoopThroughFiles()
Dim lastRow As Long
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
Dim MyFolder As String
Dim filename As Range
Dim MyFile As String
MyFolder = "E:\Folder"
For Each filename In Worksheets("Sheet1").Range("A2A:" & lastRow)
MyFile = Dir(MyFolder & "\*.xlsx")
'Here I actually need to pass all file extensions to Dir
Do While MyFile <> ""
If filename = MyFile Then
'Do Nothing
Else
filename.Interior.Color = vbRed
MyFile = Dir
Next
End Sub
The above is a failed attempt.
I thought of trying it with method similar to Find()
Sub LoopThroughFiles()
Dim lastRow As Long
'Dim LastFile As Long
'Is there need of it (LastFile variable)? I kept this variable
'to save (prior known) count of files in folder.
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
'LastFile = 'Pass count of Files in folder to this variable.
Dim fileName As Range
For Each fileName In Worksheets("Sheet1").Range("A2:A" & lastRow)
Dim rngFnder As Range
On Error Resume Next
'Error at below line.
Set rngFnder = Dir("E:\Folder\").Find(filename)
'This line gives me error 'Invalid Qualifier'
'I am trying to use method similar to Find()
If rngFnder Is Nothing Then
filename.Interior.Color = vbRed
End If
Next
End Sub
But, I couldn't achieve the result. Can anyone tell me is there any such function available to 'Find' whether all filenames in an excel exist in a folder after looping through folder using Dir?
As per my knowledge, Dir function works with only one file extension at a time.
Is it possible to use Dir function for multiple file extensions at a time?
Expected Output:
Assume I have 8 filenames in 'FileNames(.xlsx/.xlsm)'. Out of which Arabella.pdf and Clover.png are not found in 'Folder', Then I want to color cells for these filenames in red background in excel as in below image.
Sub LoopThroughFiles()
Dim lastRow As Long
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
Dim MyFolder As String
Dim filename As Range
Dim MyFile As String
MyFolder = "E:\Folder"
For Each filename In Worksheets("Sheet1").Range("A2:A" & lastRow)
MyFile = MyFolder & "\" & filename
If Not FileExists(MyFile) Then
filename.Interior.Color = vbRed
End If
Next
End Sub
Public Function FileExists(strFullpathName As String) As Boolean
If Dir(strFullpathName) <> "" Then
FileExists = True
Else
FileExists = False
End If
End Function
You can output a list of the files that are contained in the folder. I found a really helpful tutorial on that here: http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/#Jump1
If you then loop through both the original and the output lists and look for a match. Easiest is to first colour them all red, and un-colour the matches. Else you would need an additional if-statement that states: When you reach the last element in the original list, and no match has been found, then colour red.
Edit: For continuity's sake I copied the code bits of the link I mentioned above:
Getting all file names form within 1 folder:
Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:StuffFreelancesWebsiteBlogArraysPics")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name
'print file path
Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
End Sub
My goal is to write a VBA macros that will allow:
to choose a folder with files to open
then to count number of rows in each file (each file contain only 1 sheet).
to move to another folder all the files that contain more than 1 row
I'm very new in VBA, so what i found is how to count number of rows from active worksheet, but i still can't manage automatically files opening and moving to another folder:
Sub RowCount()
Dim iAreaCount As Integer
Dim i As Integer
Worksheets("Sheet1").Activate
iAreaCount = Selection.Areas.Count
If iAreaCount <= 1 Then
MsgBox "The selection contains " & Selection.Rows.Count & " rows."
Else
For i = 1 To iAreaCount
MsgBox "Area " & i & " of the selection contains " & _
Selection.Areas(i).Rows.Count & " rows."
Next i
End If
End Sub
Could someone help with this, please?
This is actually easy. Really easy. :)
First, code to choose a folder to look into for Excel files. Used Google and searched for excel vba select folder dialog. First result yields this code:
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
We'll get to using it for later. Next, we need a loop to count how many rows there are in each file/sheet. However, we can't count them without these files open. So, let's look for a code that opens workbooks in a loop. Googling excel vba open excel files in folder, we get the second result. First result is a deprecated method in Excel 2007 and up. I will be assuming you're running 2007 and up. Here's the code, applying the proper correction detailed by Siddharth Rout.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "Blah blah blah"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
Now, some semi-advanced best practices. Rather than opening each workbook/worksheet/file and counting the rows in each of the opened files (which is highly counter-intuitive), let's modify the above code to count the rows in each file as well, then move them to another folder if they have more than one (1) used row. We'll also change the above code to take into consideration as well the first function to get the folder we want to apply the second code to.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = GetFolder("C:\users\yourname\Desktop" 'Modify as needed.
MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
See what happened there? We called the GetFolder function and assigned it to MyFolder. We then concatenate MyFolder and a wildcarded string, then pass it to Dir so we can loop over the files. What's the remaining two things? Right, count the used rows AND moving the files. For the used rows, I'll hack a simple function to check the workbook's only sheet to see if the row is 2 or greater.
Function CountUsedRows(Wbk As Workbook) As Long
Dim WS As Worksheet
Set WS = Wbk.Sheets(1)
CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function
Now that's simple enough. Next, let's write a simple code to move the files. For personal purposes, I'll write a code to copy instead. It'll be up to you to modify it for moving, as that's a rather sensitive operation and if it messes up... well. Hmm. But something here tells me that there's a much better option. Copying can cause all manners of error from permission denial to erroneous copying. Since we've got the file open, why not just save them instead to the new folder?
Now, let's tie them all together neatly.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
Dim TargetWB As Workbook
MyFolder = GetFolder("C:\Users\yourname\Desktop") 'Modify as needed.
MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While MyFile <> ""
Set TargetWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
With TargetWB
If CountUsedRows(TargetWB) > 1 Then
.SaveAs "C:\Users\yourname\Desktop\Blah\CopyOf" & MyFile 'Modify as needed.
End If
.Close
End With
MyFile = Dir
Loop
Shell "explorer.exe C:\Users\yourname\Desktop\Blah", vbMaximizedFocus 'Open the folder.
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Function CountUsedRows(Wbk As Workbook) As Long
Dim WS As Worksheet
Set WS = Wbk.Sheets(1)
CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function
Tried and tested. Let us know if this works for you.
Nice answer from Manhattan: that's exactly how I use Excel's built-in functionality to select a folder and fetch a set of file names.
However, there's an interesting side-question in there:
Are those single-sheet Excel files workbooks, of just .csv text files?
If they have a .csv extension, you don't need to open them in Excel to count the rows!
Here's the code to do it:
Fast VBA for Counting Rows in a CSV file
Public Function FileRowCount(FilePath As String, Optional RowDelimiter As String = vbCr) As Long
' Returns the row count of a text file, including the header row
' Returns - 1 on error
' Unicode-compliant, works on UTF-8, UTF-16, ASCII, with or without a Byte order Marker.
' Reads a typical 30Mb file over the network in 200-300ms. Hint: always copy to a local folder.
' If you're scanning files for use with a SQL driver, use basSQL.TableRowCount: it's 20x slower,
' but it returns a proper test of the file's usability as a SQL 'table'
' Nigel Heffernan Excellerando.Blogspot.com 2015
' Unit test:
' s=Timer : for i = 0 to 99 : n=FileRowCount("C:\Temp\MyFile.csv") : Next i : Print Format(n,"#,##0") & " rows in " & FORMAT((Timer-s)/i,"0.000") & " sec"
' Network performance on a good day: reads ~ 150 MB/second, plus an overhead of 70 ms for each file
' Local-drive performance: ~ 4.5 GB/second, plus an overhead of 4 ms for each file
On Error Resume Next
Dim hndFile As Long
Dim lngRowCount As Long
Dim lngOffset As Long
Dim lngFileLen As Long
Const CHUNK_SIZE As Long = 8192
Dim strChunk As String * CHUNK_SIZE
If Len(Dir(FilePath, vbNormal)) < 1 Then
FileRowCount = -1
Exit Function
End If
' trap the error of a folder path without a filename:
If FileName(FilePath) = "" Then
FileRowCount = -1
Exit Function
End If
hndFile = FreeFile
Open FilePath For Binary Access Read Shared As #hndFile
lngFileLen = LOF(hndFile)
lngOffset = 1
Do Until EOF(hndFile)
Get #hndFile, , strChunk
FileRowCount = FileRowCount + UBound(Split(strChunk, RowDelimiter))
Loop
Close #hndFile
Erase arrBytes
End Function
Public Function FileName(Path As String) As String
' Strip the folder and path from a file's path string, leaving only the file name
' This does not check for the existence or accessibility of the file:
' all we're doing here is string-handling
' Nigel Heffernan Excellerando.Blogspot.com 2011
Dim strPath As String
Dim arrPath() As String
Const BACKSLASH As String * 1 = "\"
strPath = Trim(Path)
If strPath = "" Then Exit Function
If Right$(strPath, 1) = BACKSLASH Then Exit Function
arrPath = Split(strPath, BACKSLASH)
If UBound(arrPath) = 0 Then ' does not contain "\"
FileName = Path
Else
FileName = arrPath(UBound(arrPath))
End If
Erase arrPath
End Function
Note the use of the Split function to count the row separators: VBA's string-handling is generally slow, especially when you concatenate strings, but there are a couple of places where VBA can perform a string manipulation without internal allocation and deallocation; if you know where they are, you'll find that parts of your code run as fast as a 'C' developer's best work.
Warning: Horrible Hack
Strictly speaking, I should declare Dim arrBytes(CHUNK_SIZE) As Byte and use this Byte array instead of strChunk to receive the Get from a file opened for binary read.
There are two reasons for not doing it the 'right' way:The last Get, which will set end-of-file TRUE, will extract less data from the file than the full 'chunk'. What happens next is that these last few bytes of the file are written into the array without clearing out the data from the previous 'Get'. So you have to do additional plumbing, counting bytes off against LOF(#hwndFile) to detect the 'Last Get' and branching into a statement that clears the buffer, or allocates a smaller byte array and uses that instead;The code will only cope with UTF-8 2-byte encoded character sets, or with single-byte encoded ASCII 'Latin' text if you do a bit of byte-array substitution around your row delimiters.The VBA String type is a byte array with a wrapper that allows your code (or rather, the compiler) to handle all that complexity in the background.
However, it's much faster to go back into the primordial C, using old-school Get statements, than using later libraries like Scripting.FileSystemObject. Also, you have some ability to examine the incoming data at the byte level, to debug issues where you're getting '???????' characters instead of the text you were expecting.
Anyway: this is late to the game, as StackOverflow answers go, and it's an answer to the less-interesting part of your question. But it's going to be interesting to people who need a quick rowcount in their data files, and your question comes at the top of the list when they search for that.
In the code below I could wrote a code to display filenames from a folder. The problem is now that I should display them in the correct Row. For now they are displayed in random sequence and that is not the purpose.
In column "A" the filenames to search for are called with similar name format PBM12.T5.103.
The actual filename to find is called with similar name format 1_29_PBM_12_T5__103.
I have to find a solution to compare "only" the Fat marked letters and numbers like displayed here above, without . or _
As you will see PBM12T5103 is returning in both namestructures.
Please don't try fixed length counts because the filenames are dynamic and the amount of letters are variable. The comparison of the SUBSTITUTED length of column "A" ( PBM12T5103) is the key to comparison but I can not handle to establish this comparison.
When the filename in column "A" has been found, in column "C" the full filename of found file has to be displayed as the original format 1_29_PBM_12_T5__103
Maybe a solution can be found when extra columns can be made to establish the comparison?
In Excel I could approach a solution, but this will not work automized like it should do.
I made the LEN(count dynamic), but this is still no solution to display the full filenames in the required row...
Hopefully somebody can help me out ..
Option Explicit
Sub fileNames_in_folder()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
fldpath = "C:\"
On Error Resume Next
Thisworkbook.Sheets("1").Activate
'start count row
j = 11
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
For Each fil In fld.Files
'here I have to add an IF statement in order to compare the filenames written in column "A" with files from folderPath C:\"
'When the correct files is found it should be displayed in column "C"
If
then
Cells(j, 34).Value = fso.GetBaseName(fil.path)
End If
'count behaviour
j = j + 1
Next
Columns("AH").AutoFit
End Sub
I will suggest you different way of getting file names. Instead of FileSystemObject let's use simple Dir function which allows to check the pattern of file name.
1) Files in my testing folder are as follows
2) I assumed that file pattern is as follows:
XXXY.Z.W
where:
XXX > 3 letters text
Y > any length number/text
Z > any length number/text
W > any length number/text
3) The code of subroutine is placed in 2013-06-01...xlsm file which you could see in the pic above (the same folder where your files are). Code is as follows (change where appropriate):
Sub solution()
Dim j As Long, LastRow As Long
Dim fldPath
'your path below
fldPath = ThisWorkbook.Path
ChDir fldPath
Dim arrPattern As Variant
Dim filName As String
For j = 1 To Range("A1").End(xlDown).Row
arrPattern = Split(Cells(j, "A"), ".")
'I suggest to use different way of checking _
pattern of file name. Pattern rules:
'*YYY*XX*Z*W*
filName = Dir("*" & Left(arrPattern(0), 3) & "*" & _
Mid(arrPattern(0), 4) & "*" & _
arrPattern(1) & "*" & _
arrPattern(2) & "*")
If Len(filName) > 0 Then
Cells(j, "B") = filName
Else
Cells(j, "B") = "not found"
End If
Next j
End Sub
4) results are presented in the picture below: