I am looking for a code that will open a workbook based on the output of a formula. I have files which are named by the date e.g. 20210807 in the format JJJJMMTT. What I need is that if I run the VBA on the file "20210807" then the workbook "20210806" shall be opened. The purpose of this is, because the VBA I run on a file always reference to the previous day and I cannot retrieve data if the workbook is not open.
Is that possible? I have tried it with that code, but it doesn't work and it looks very wrong to me, but I have no clue.
Workbooks.Open FileName:= _
"=INDIRECT(CONCATENATE(LEFT(CELL(""filename""),LEN(CELL(""filename""))-13),LEFT(RIGHT(CELL(""filename""),13),8)+1,"".xlsx"",)"
You need to evaluate the formula to get its result:
Workbooks.Open FileName:=Evaluate("=INDIRECT(CONCATENATE(LEFT(CELL(""filename""),LEN(CELL(""filename""))-13),LEFT(RIGHT(CELL(""filename""),13),8)+1,"".xlsx"",)")
And you should check if the file exists or put some error handling (see VBA Error Handling – A Complete Guide) so in case the file cannot be loaded your code can handle this.
For Example:
Option Explicit
Public Sub Example()
' your code goes here …
Dim OpenFileName As String
OpenFileName = Evaluate("=INDIRECT(CONCATENATE(LEFT(CELL(""filename""),LEN(CELL(""filename""))-13),LEFT(RIGHT(CELL(""filename""),13),8)+1,"".xlsx"",)"))
On Error Goto ERR_OPEN_FILE ' on error jump to error handler
Dim WbOpen As Workbook
Set WbOpen = Workbooks.Open(FileName:=OpenFileName)
On Error Goto 0 ' re-activate error reporting
' your code goes here …
' example:
WbOpen.Worksheets("Sheet1").Range("A1").Value = "Test"
WbOpen.Close SaveChanges:=False
Exit Sub ' exit here if no error occured.
ERR_OPEN_FILE:
MsgBox "File '" & OpenFileName & "' could not be opened:" & vbCrLf & Err.Description, vbCritical, "Error " & Err.Number
Err.Clear
End Sub
If your filename is 20210807.xlsm you can subtact 1 from the day 07. But what if the file name is 20210801 then this idea ob subtracting one does not work anymore.
You need to convert the string 20210807 into a real numeric date to be able to subtract one day and get the correct result as a date that you can use to build your new file name:
Public Function GetPreviousDayFileName(ByVal ThisFileName As String) As String
'ThisFileName = "20210807.xlsm"
Dim ThisYear As String
ThisYear = Left$(ThisFileName, 4) ' 2021
Dim ThisMonth As String
ThisMonth = Mid$(ThisFileName, 5, 2) ' 08
Dim ThisDay As String
ThisDay = Mid$(ThisFileName, 7, 2) ' 07
Dim ThisDate As Date
ThisDate = DateSerial(CInt(ThisYear), CInt(ThisMonth), CInt(ThisDay))
Dim PreviousDate As Date
PreviousDate = DateAdd("d", -1, ThisDate) ' subtract one day
' generate file name
GetPreviousDayFileName = Format$(PreviousDate, "YYYYMMDD") & ".xlsx"
End Function
And use it in the first example code like this:
OpenFileName = ThisWorkbook.Path & Application.PathSeparator & GetPreviousDayFileName(ThisWorkbook.Name)
I have tried, but I don't know if I understood it perfectly. I have an additional question. So I have built this Vlookup and now want to replace a part from it with your code.
This is the code: "=IF(ISNA(VLOOKUP(RC[-1],INDIRECT(CONCATENATE(""'"",LEFT(RIGHT(CELL(""Dateiname""),13),8)-1,"".xlsx'!$A:$AP"")),2,FALSE)),DATE(LEFT(LEFT(RIGHT(CELL(""Dateiname""),13),8),4),MID(LEFT(RIGHT(CELL(""Dateiname""),13),8),5,2),RIGHT(LEFT(RIGHT(CELL(""Dateiname""),13),8),2)),VLOOKUP(RC[-1],INDIRECT(CONCATENATE(""'"",LEFT(RIGHT(CELL(""Dateiname""),13),8)-1,"".xlsx'!$A:$AP"")),2,FALSE))"
Whereas the part:
CONCATENATE(""'"",LEFT(RIGHT(CELL(""Dateiname""),13),8)-1,"".xlsx'!$A:$AP"")
is equal to:
CONCATENATE(GetPreviousDayFileName, "$A:$AP")
But this is not working. What do I miss
Related
hope you're fine,
i want a macro to read multiple excel files and insert a value in specific cell ( for example C3 or A1 or any cell declared in the code)
here firs image of my code, just a button
and here is my code:
Sub InsertValueInCell()
Range("C3").Value = _
InputBox(Prompt:="Enter the value you want to insert.")
End Sub
this code give me this result right now, it's just insert the data in the actual workbook :
TEST-1
TEST-2
Thanks in advance to help me to complete the code cause i want the code to read multiple excel files and after that i can insert a value in specific cell for all thos excel files.
Thanks in advance
Have a good day All
here is my code for the moment:
Sub InsertValueInCell()
Range("C3").Value = _
InputBox(Prompt:="Enter the value you want to insert.")
End Sub
this code give me this result right now, it's just insert the data in the actual workbook :
TEST-1
TEST-2
Thanks in advance to help me to complete the code cause i want the code to read multiple excel files and after that i can insert a value in specific cell for all those excel files (for example i want to insert a value in the C3 cell for all those excel files).
Thanks in advance
Have a good day All
This should work for you:
Option Explicit 'Must be at very top of module, before any procedures.
'Possibly the most important line in any code - forces you to declare your variables.
Public Sub AddValueToSheet()
On Error GoTo ERROR_HANDLER
'The Sheet to changed.
Dim SheetName As String
SheetName = "Sheet1"
'Get a collection of files within the folder.
Dim FileCollection As Collection
Set FileCollection = New Collection
Set FileCollection = EnumerateFiles("<folder path>\") 'Don't forget the final backslash.
Dim ValueToEnter As String 'or whatever type you're trying to enter.
ValueToEnter = InputBox("Enter the value you want to insert")
'Look at each item in the collection.
Dim wrkBkPath As Variant
For Each wrkBkPath In FileCollection
'Open the workbook.
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open(wrkBkPath)
'Check if the sheet exists.
'Add the value if it does, add the file name to the MissingSheetList string if it doesn't.
Dim MissingSheetList As String
If SheetExists(wrkBk, SheetName) Then
wrkBk.Worksheets(SheetName).Range("A1") = ValueToEnter
Else
MissingSheetList = MissingSheetList & wrkBk.Name & vbCrLf
End If
'Save and close.
wrkBk.Close SaveChanges:=True
Next wrkBkPath
'Display missing sheet list message if there's any.
If MissingSheetList <> "" Then
MsgBox "The files were missing " & SheetName & vbCr & vbCr & MissingSheetList, vbInformation + vbOKOnly
End If
Exit Sub
'If an error occurs code skips to this section.
ERROR_HANDLER:
Dim ErrMsg As String
ErrMsg = "AddValueToSheet()" & vbCr & Err.Description
'Add error handling code.
Select Case Err.Number
Case Else
End Select
End Sub
'Check if a sheet exists by trying to set a reference to it.
Private Function SheetExists(wrkBk As Workbook, SheetName As String) As Boolean
On Error Resume Next
Dim ShtRef As Worksheet
Set ShtRef = wrkBk.Worksheets(SheetName)
SheetExists = (Err.Number = 0) 'Was an error returned? True or False.
On Error GoTo 0
End Function
'Returns all xls* files from the path supplied by sDirectory.
'Each file path is added to the FilePaths collection.
Private Function EnumerateFiles(ByVal sDirectory As String) As Collection
On Error GoTo ERROR_HANDLER
'You can remove StatusBar lines if you want - code might run too fast to see anyway.
Application.StatusBar = "Collating files: " & sDirectory 'Update status bar.
Dim cTemp As Collection
Set cTemp = New Collection
Dim sTemp As String
sTemp = Dir$(sDirectory & "*.xls*")
Do While Len(sTemp) > 0
cTemp.Add sDirectory & sTemp
sTemp = Dir$
Loop
Set EnumerateFiles = cTemp
Application.StatusBar = False 'Reset status bar.
Exit Function
'If an error occurs code skips to this section.
ERROR_HANDLER:
Dim ErrMsg As String
ErrMsg = "EnumerateFiles()" & vbCr & Err.Description
'Add error handling code.
Select Case Err.Number
Case Else
End Select
End Function
After a recent windows update, a previous Excel vba script that was working, no longer functions correctly.
The macro operation, when working, opens a csv file that is defined in the active workbook as String aString. The csv file contains a list of variables and corresponding values for those variables. The macro returns the original active workbook and reads the defined named cells in the active workbook and updates those named cells with the values defined in the csv file.
The issue appears to be that despite returning to the original active workbook the command to generate the For loop to cycle through the named cells no longer returns a value for the variable name or which worksheet the variable lives in.
The command is:
' Process to update name values
Workbooks(strWorkBook).Activate
' Windows(strWorkBook).Activate
' Dim nm As Variant
' For Each nm In ActiveWorkbook.Names
For Each nm In Workbooks(strWorkBook).Names
varname = nm.Name
MsgBox "varname " & varname & " nm " & nm
varsheet = Range(nm).Parent.Name
MsgBox "varsheet " & varsheet
The message for the varname is now:
The message should read varname aString nm $D$4
Pretty sure it is update version related, as in Excel build Version 1902 (Build 11328.20318) it works but not in Version 2002 (Build 12527.21416)
Thanks in advance for your help. Related forums point to security update issues with Windows but no solutions I can implement yet.
======================================================
Update from further testing:
I created a new workbook and built the macro that is failing in the new workbook using Excel Version 2002 (Build 12527.21416). The macro runs perfectly in the new version of the Excel file but continues to produce the error message above in the legacy file.
I'm suspecting there are some issues related to security updates in the Version 2002 build that are not compatible with the Version 1902 build but cannot identify what the issues are.
The macro that runs in the new version but not the original document is:
Public Sub testName()
Dim filePath As String
Dim inFilePath As String
Dim inCase As String
'On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
'----------------------------------
' Find path for input file
strWorkBook = ActiveWorkbook.Name
' MsgBox strWorkBook
filePath = Range("aString").Value
tmpsep = InStrRev(filePath, "\")
' Input file workbook name
inCase = Right(filePath, Len(filePath) - tmpsep)
'Input file full path
inFilePath = Left(filePath, Len(filePath) - Len(inCase))
' Open input data file
Workbooks.Open Filename:=filePath
'' Find last row in file
' Call FindLastRow.FindLastRow(lRow)
' rngend = lRow + 2
'' MsgBox rngend
Workbooks(strWorkBook).Activate
'
' VBA script to read external CSV file' For Each nm In ActiveWorkbook.Names
For Each nm In Workbooks(strWorkBook).Names
varname = nm.Name
MsgBox "varname " & varname & " nm " & nm
varsheet = Range(nm).Parent.Name
MsgBox "varsheet " & varsheet
varcell = nm.RefersToRange.Address(False, False)
NextIteration:
Next nm
End Sub
Your problem stems from the misdeclaration of the variable Nm. In fact, it's not declared (and you are missing Option Explicit at the top of your module) which makes it a Variant. Excel appears unable to fit the Name object into the variant as you intend within the rather complicated environment you create (more about that further down). This code will work.
Dim Nm As Name
Dim varName As String
Dim varSheet As String
Dim varCell As String
' For Each Nm In ActiveWorkbook.Names
For Each Nm In Workbooks(strWorkBook).Names
With Nm
varName = .Name
varSheet = .RefersToRange.Parent.Name
varCell = .RefersToRange.Address(0, 0)
End With
MsgBox "Named range """ & varName & """ refers to range" & vbCr & _
varCell & " on sheet """ & varSheet & """."
Next Nm
I tested the above code on the ActiveWorkbook but it should work on any other as well. I tested in Excel 365 but that shouldn't make a difference, either.
The complication mentioned above stems from this part of your code, Range(nm).Parent.Name. In this context nm is a string. But in the context of your loop nm is a Name object. So, whereas in the older version apparently the default property of the Name object was the referenced range address it now would appear to be something else. It doesn't really matter because the Name object has several properties from which the referenced range can be extracted as a range or its address, and once you specify the one you want to use there is no need to ask VBA to use the default.
Incidentally, Range("anything")will always be on the ActiveSheet, and Range("Sheet13!A2:A4").Parent will return an error rather than Sheet13. Therefore, if you need to know the sheet of the range on which the named range resides you should look for another method of getting at it.
Problem solved thanks to this thread stackflow thread and user Jenn.
It seems that between Excel V1902 and V2002 a hidden variable _xlfn.SINGLE exists in the workbook. When the macro loops through, it sees the named range, cannot resolve its address or sheet location and stops. Not until running Jenn's code could I see the hidden variable.
The easiest solution was to include an IF loop to bypass this variable if defined and continue as normal (as per below). The sheet is working now but I will not get those 2 days of my life back.
For Each Nm In Workbooks(strWorkBook).Names
If Nm.Name Like "_xlfn*" Then
GoTo NextIteration
End If
With Nm
varName = .Name
varSheet = .RefersToRange.Parent.Name
varCell = .RefersToRange.Address(0, 0)
End With
MsgBox "Named range """ & varName & """ refers to range" & vbCr & _
varCell & " on sheet """ & varSheet & """."
NextIteration:
Next Nm
Thanks to those who commented on the thread and Variatus I will update those declarations.
I have a VBA macro in Excel which opens both the source and targets files, copies the required data and closes the files. The target filename is always the same, but the source file is a new file every day with the date as part of the name. The name format is SB20200613.DBF. This is today's file 13 June. For all of 2020, the files will always be SB2020XXXX.DBF.
Here is the macro
Public Sub Copy_DBF_to_Workbook()
Const cRootFolder As String = "C:\Price\" ' <<<<< change accordingly (without year!)
Const cDestWorkBk As String = "Prices.xlsx"
Dim oWsSrc As Worksheet
Dim oWsDest As Worksheet
Dim raSrc As Range
Dim raDest As Range
Dim sPath As String
Dim sDBF As String
Dim sFName As String
Dim dtDate As Date
' assign current date
dtDate = Date
' assign yesterday's date
' dtDate = Date - 1
' compose path for current year
sPath = cRootFolder & Year(dtDate) & "\"
' compose file name
sDBF = "SB" & Year(dtDate) & IIf(Len(Month(dtDate)) = 1, "0" & Month(dtDate), Month(dtDate)) & _
IIf(Len(Day(dtDate)) = 1, "0" & Day(dtDate), Day(dtDate)) & ".dbf"
' check within folder on existence of file
sFName = Dir(sPath & sDBF)
If Len(sFName) > 0 Then
' open DBF file
On Error Resume Next
Set oWsSrc = Workbooks.Open(sPath & sFName).ActiveSheet
If oWsSrc Is Nothing Then GoTo ERROR_DBF
' open destination workbook
Set oWsDest = Workbooks.Open(sPath & cDestWorkBk).ActiveSheet
On Error GoTo 0
If oWsDest Is Nothing Then GoTo ERROR_PRICES
' determine range to be copied
With oWsSrc.Cells.CurrentRegion
Set raSrc = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
End With
' determine destination; first available row in column B
Set raDest = oWsDest.Cells(oWsDest.Rows.Count, "B").End(xlUp).Offset(1, 0)
' perform copy
raSrc.Copy Destination:=raDest
' save prices.xlsx
oWsDest.Parent.Save
oWsDest.Parent.Close
' close DBF
oWsSrc.Parent.Close SaveChanges:=False
Else
MsgBox "DBF file [" & sPath & sDBF & "] not found.", vbExclamation
End If
GoTo DONE
ERROR_DBF:
MsgBox "Error opening DBF file " & sPath & sDBF, vbExclamation
Exit Sub
ERROR_PRICES:
MsgBox "Error opening workbook " & sPath & cDestWorkBk, vbExclamation
DONE:
End Sub
That works well for today, but I also have a data created each day for the following day, so I need to duplicate this macro, but have it look not for today's file, but for tomorrow's file. I tried simply making this change
' assign current date
dtDate = Date + 1
but the macro still performs the task on today's data file.
Any thoughts on what requires changing to have the macro open tomorrows DBF file instead?
cheers
I'm trying to insert formulas into my worksheet, but my first and second attempts haven't gone so well.
So, first I thought it would be better to use the GetOpenFilename feature for accuracy's sake, rather than having the user input the name of the workbook themselves. I used this page and this answer while writing it. When I run the code, the Open dialogue box opens, but when I select a workbook I keep getting a:
"Runtime Error '424': object required".
I'm not sure what it's asking for? At first I had just Application.GetOpenFilename(), so I thought I needed to add the filter, but it didn't help.
Sub openfile()
Dim mainwb As Workbook
Set mainwb = Application.GetOpenFilename("Microsoft Excel Files, *.xls*")
Dim mainws As Worksheet
mainws = InputBox("Please enter the name of the worksheet")
Dim rdsMonthly As Variant
rdsMonthly = InputBox("Please insert current month column in format $A:$A")
Dim rdsID As Variant
rdsID = InputBox("Please insert ID column in format $A:$A")
Cells(8, 14) = "=IFERROR(SUMIFS('[" & mainwb & "]" & mainws & "'!" & rdsMonthly & ", '[" & mainwb & "]" & mainws & "'!" & rdsID & ", $C55), " & Chr(34) & Chr(34) & ")"
End Sub
After, I tried using an Input box instead
Dim mainwb As Workbook
mainwb = InputBox("Please enter the name of the workbook, including file extension")
But that's giving me a:
"Runtime error '91': Object variable or With block variable not set".
I have no idea what it wants from me, and I'd really appreciate any help!
To get the name of the workbook, indicated with .GetOpenFileName, you may split once the big string through / and then get the last item. Then, split again by .xls and take the 0th item. With 1 line this 2 operations look like this:
Sub TestMe()
Dim filePath As String
filePath = Application.GetOpenFilename("Microsoft Excel Files, *.xls*")
Dim nameOfWb As String
'do not do this at production, but split it to variables:
nameOfWb = Split(Split(filePath, "\")(UBound(Split(filePath, "\"))), ".xls")(0)
Debug.Print nameOfWb
End Sub
Application.GetOpenFilename("Microsoft Excel Files, *.xls*") returns a string of the workbook path. And Workbooks() needs a workbook name, which is already opened.
Try this:
Sub TestMe()
Dim mainwb As Workbook
Set mainwb = Workbooks.Open(Application.GetOpenFilename("Microsoft Excel Files, *.xls*"))
MsgBox mainwb.Name
End Sub
Application.GetOpenFileName
I have some code which looks for a value with a given sheet name in two separate workbooks.
What I want to do is when the first workbook does not have the sheet, instead of the following prompt coming up, it cancels/throws an error and using the error handling goes to the second spreadsheet. How do I do this?
Currently I am using this code to achieve this:
fFormString1 = "'" & wkBookRef1 & firstShtName & "'!$L$6/1000"
fFormString2 = "'" & wkBookRef2 & firstShtName & "'!$L$6/1000"
Application.DisplayAlerts = False 'Does nothing to the prompt
On Error GoTo tryTwo 'Following only throws error when prompt is canceled
ThisWorkbook.Sheets("Place").Range("E53").Formula = "=" & fFormString1
GoTo endTen
tryTwo:
ThisWorkbook.Sheets("Place").Range("E53").Formula = "=IFERROR(" & fFormString2 & ","""")"
On Error Resume Next
endTen:
Application.DisplayAlerts = True 'Does nothing to the prompt
Note: I wish to do this with the spreadsheet closed ideally. Or visually not present to improve speed and smoothness of operation for my client.
ExecuteExcel4Macro will return a value from a closed workbook. If the worksheet doesn't exist it will throw an error 1004 'A formula in this worksheet contains one or more invalid references.
ExternalWorksheetExists uses this to test it the worksheet exist.
Function ExternalWorksheetExists(FilePath As String, FileName As String, WorksheetName As String) As Boolean
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
On Error Resume Next
Call ExecuteExcel4Macro("'" & FilePath & "[" & FileName & "]" & WorksheetName & "'!R3C3")
ExternalWorksheetExists = Err.Number = 0
On Error GoTo 0
End Function
When using ExecuteExcel4Macro, all references must be given as R1C1 strings. Here is an example of a valid string:
ExecuteExcel4Macro("'C:\Users\tinzina\Documents\[Book1.xlsm]Sheet1'!R6C12")
Borrowing heavily from Thomas' answer (full credit is due). However it seems that this didn't work for you.
Use ExecuteExcel4Macro but ascribe the value to the variable val. Then check if this is the error you are looking for Error(2023).
Please find the code below:
'Check if the sheet exists in the workbook, used to check which forecast file one should look in
Function ExtSheetExists(formString) As Boolean 'Form string is a formula string with both the worksheet and the workbook
Dim val As Variant
'Tries to execute formula and throws error if it doesn't exist
On Error Resume Next
val = ExecuteExcel4Macro(formString)
ExtSheetExists = (val <> Error(2023)) 'Returns False if the sheet does not exist based on Error 2023
On Error GoTo 0
End Function