File Path Changed Dependent On Cell Value (VBA) - vba

i think this will be really basic and i have tried to refer to multiple threads (How to use file path from a cell in VBA?). But cant seem to get any code working without any issues.
Basically what i want to do is open different XL files dependent on an input from a cell, all the files are in the same location (folder), but obviously the name will alter. So in cell C3 i write a number e.g. 12345 and i want it to look in a constant folder for the corresponding named XL document.
All files are saved in C:\ ***** \ *****\Documents\My Work, i want to open the folder C:\ ***** \ *****\Documents\My Work\12345.XLS which changes dependent on C3.
Here is the code i attempted to use:
Sub Macro()
Dim Filelocation As String
Dim File As String
Dim Filepathfull As String
Filelocation = "C:\ ***** \ *****\Documents\My Work"
File = "C3"
Filepathfull="Filelocation & "\" & "File" & ".xlsx"
Workbooks.Open(Filename:=Filepathfull)
End Sub
Ill keep looking in the meantime! thanks for your help in advance.
EDIT WITH ANSWER:
Sub Macro()
Dim Filelocation As String
Dim File As String
Dim Filepathfull As String
Filelocation = "C:\ ***** \ *****\Documents\My Work"
File = "C3"
Filepathfull = Filelocation & "\" & Range(File).Value & ".xlsx"
Workbooks.Open (Filepathfull)
End Sub

Try this (Untested)
Filepathfull= Filelocation & "\" & Sheets("Sheet1").Range(File).Value & ".xls"
Filelocation and File are variables. Treat them as such. Anything that you put in quotes will be considered as a string.
In the above code change Sheet1 to the relevant sheet. i.e the sheet where the file names are.

Related

Wildcards Not Working on Excel 15 VBA Dir()

I've been trying to do something REALLY simple here but, for whatever the reason, it's not working.
All that I'm trying to do is to get all the .txt files from a specific directory using a wildcard.
Here is the full code that I'm using:
Sub RenameFiles()
'Variables Declaration
Dim vSpreadsheetPath As String
Dim vFolderName As String
Dim vFilesPath As String
Dim vFile As String
Dim vRow As Long
Dim vFilter As String
'Getting the vFile path
vSpreadsheetPath = ActiveWorkbook.Path
vFolderName = "COMBINED FOLDER"
vFilter = "*.txt"
vFilesPath = vSpreadsheetPath & Application.PathSeparator & vFolderName & Application.PathSeparator
vFile = Dir(vFilesPath & vFilter)
MsgBox (vFile)
End Sub
But nothing shows in the result.
The weirdest thing is:
If I use
file = Dir(vFilesPath & "filename.txt")
It works
But if I try to use any Wildcard, like the one bellow, it doesn't.
file = Dir(vFilesPath & "filename.t*")
Any idea of what I might be doing wrong?
It is relevant that you're on a Mac since Mac's don't use wildcards like Windows.
You'll need a different approach or a new (re-worded) question for more information about handling the Mac file system with VBA.
This should help get you started.
(Posted as an answer by O.P. request.) :-)

Go up one folder level

I have a Macro that gets sub folder data. However I also want something from the main folder.
I looked at How to get current working directory using vba? but need to change activeworkbook path:
Application.ActiveWorkbook.Path might be "c:\parent\subfolder"
I would want
"c:\parent\"
Using Excel 365 VBA
As the path may not be the current working directory you need to extract the path from the string.
Find the last \ and read all characters to the left:
ParentPath = Left$(Path, InStrRev(Path, "\"))
If you are working around the current directory ChDir ".." will jump you up one level, the new path can be returned by CurrDir.
The most reliable way to do this is to use the Scripting.FileSystemObject. It has a method that will get the parent folder without trying to parse it:
With CreateObject("Scripting.FileSystemObject")
Debug.Print .GetParentFolderName(Application.ActiveWorkbook.Path)
End With
Dim WbDir As String
Dim OneLvlUpDir As String
'get current WorkBook directory
WbDir = Application.ActiveWorkbook.Path
'get directory one level up
ChDir WbDir
ChDir ".."
'print new working directory and save as string. Use as needed.
Debug.Print CurDir()
OneLvlUpDir = CurDir()
I think you mean this solution:
Sub t()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
MsgBox "ThisWorkbook.Path = " & ThisWorkbook.Path & vbLf & _
"Path one folder down = " & fso.GetFolder(ThisWorkbook.Path & "\." & "NewFolder").Path
Set fso = Nothing
End Sub

excel-VBA: copying last column with dynamic paths and names

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.

Create New Text File Named After a Cell When Meeting a Criteria

I've looked and found a little help so far but I'm stuggling with the for each logic for this Excel Macro I'm trying to make.
Basically I have 4 columns of data. Column A has the name of something and column D has either TRUE or FALSE.
I would like a macro wired to a button that creates a new text file in a given directory named after the content of Col A but only if Col D in that row is labled as "TRUE".
For example if I have the following.
ColA = Test ColD = TRUE
ColA = Test2 ColD = FALSE
ColA = Test3 ColD = TRUE
I will get 2 text files anmed Test.txt and Test3.txt.
I know I need a for each loop to look through the range of a1-d(whatever number) and then when D = True do a SaveAs I guess??
This is the code I have so far (yes I know it's very incomplete but this is as far as my logic got before hitting a wall).
Dim fileName As String
Dim filePath As String
Dim curCell As Object
Dim hideRange As Range
filePath = "C:\ExcelTest\"
hideRange = Range("D1:D1048576")
fileName = *Content of Cell A from this Row*
For Each Row In Range("A1:D1048576")
IF curCell.value In Range hideRange = "TRUE"
Then curCell.SaveAs fileName & ".txt, xlTextWindows
Any help or even pointing me in the right direction would be great. I searched around a bit for some examples and couldn't find anything that really matched what I wanted to do.
You are pretty close, but you are looping one hell of a lot of cells there.
Here is the code to loop the rows, this stops at the last populated cell in the column.
Sub LoopRows()
dim sht as worksheet
set sht = Thisworkbook.Sheets("Name of Worksheet")
'loop from row 1 to the last row containing data
For i = 1 To sht.Range("A:A").End(xlDown).Row
'check the value in column 4 for this row (i)
If sht.Cells(i, 4).Text = "TRUE" Then
CreateFile sht.Cells(i, 1).Value
End If
Next i
End Sub
For writing the file, to keep it simple it would reference Microsoft scripting runtime and do it as follows:
Sub CreateFile(FileName As String)
Dim fso As New FileSystemObject
fso.CreateTextFile "c:\temp\" & FileName & ".txt", True
End Sub
EDIT
I can't see why you aren't getting a file created, my tests work fine for me on a windows machine.
Can you please try the following code alone in a button and see if it opens a text file?
Dim fso As New FileSystemObject
fso.CreateTextFile "c:\temp\testfso.txt"
Shell "C:\WINDOWS\notepad.exe c:\temp\testfso.txt", vbMaximizedFocus
EDIT 2
Try this, and see if it opens the text file..
Sub CreateFile(FileName As String)
Dim fso As New FileSystemObject
Dim fName as String
fName = "c:\temp\" & FileName & ".txt"
fso.CreateTextFile fName, True
Shell "C:\WINDOWS\notepad.exe " & fName, vbMaximizedFocus
End Sub
What you are looking for is something like this:
Sub test()
Dim filePath As String
filePath = "C:\ExcelTest\"
Dim xRow As Variant
For Each xRow In Range("A1:D100").Rows
If xRow(1, 4).Value = "TRUE" Then
Open filePath & xRow(1, 1) & ".txt" For Output As #1
Write #1, xRow(1, 2), xRow(1, 3)
Close #1
End If
Next
End Sub
While it works without errors, I would not use it as it is right now.
If you have any questions, just ask.
EDIT
I've run some tests and noticed windows prevents me to create files inside specific folders... pls try this as a new sub and run it:
Sub testForText()
Open Environ("AppData") & "\Testing.txt" For Output As #1
Write #1, "dada"
Close #1
Shell "notepad.exe " & Environ("AppData") & "\Testing.txt", vbNormalFocus
End Sub
Then tell me if notepad opens up with "Testing.txt"

Using cell value as filename for workbook when saving

I have a macro and would like to save the workbook using the value in a cell as the name of the file: Here is what I have so far.
Dim FName As String
Dim FPath As String
Sheets("As Adjusted").Select
FPath = "N:\PricingAudit\FY15 Price Increase\ Phase 1 Built Tools"
FName = Sheets("As Adjusted").Range("C4").Text
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
I get a Save as method failed when run. Any advice would be great. The only thing I can think of would be that Column C is hidden.
Any help would be appreciated.
Thanks,
Your path is invalid. There is an extra space in front of \ Phase 1 Built Tools.