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.
Related
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
I need your help. I found the attached vba code but when I run the code I am getting a very strange 1004 error. Could you please give an explanation or try to fix this error?
Thank you so much all!
' Module to remove all hidden names on active workbook
Sub Remove_Hidden_Names()
' Dimension variables.
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant
' Loop once for each name in the workbook.
For Each xName In ActiveWorkbook.Names
'If a name is not visible (it is hidden)...
If xName.Visible = True Then
Vis = "Visible"
Else
Vis = "Hidden"
End If
' ...ask whether or not to delete the name.
Result = MsgBox(prompt:="Delete " & Vis & " Name " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Which refers to: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNo)
' If the result is true, then delete the name.
If Result = vbYes Then xName.Delete
' Loop to the next name.
Next xName
End Sub
These Excel built-in range names appear in the Excel name manager when using SUMIFS,IFERROR, COUNTIFS and other formulas.
There are a lot of ways around this, as suggested in the comments.
You can add either of these:
If Not xName.Name Like "_xlfn*" Then
'Or
If InStr(xName.Name, "_xlfn") = 0 Then
first thing in the loop (don't forget to close it), or something similar.
If you for some reason still want to see it, you can add it to the delete if:
If Result = vbYes And Not xName.Name Like "_xlfn*" Then xName.Delete
I've been using a function from another StackOverflow question (I'm SO sorry I can't find the original answer!) to help go through a number of cells in Column L that contains a formula that spits our a hyperlinked filepath. It is meant to open each one (workbook), update the values, then save and close the workbook before opening the next one. See below.
Sub List_UpdateAndSave()
Dim lr As Long
Dim i As Integer
Dim WBSsource As Workbook
Dim FileNames As Variant
Dim msg As String
' Update the individual credit models
With ThisWorkbook.Sheets("List")
lr = .Cells(.Rows.Count, "L").End(xlUp).Row
FileNames = .Range("L2:L" & lr).Value
End With
For i = LBound(FileNames, 1) To UBound(FileNames, 1)
On Error Resume Next
If FileNames(i, 1) Like "*.xls*" Then
Set WBSsource = Workbooks.Open(FileNames(i, 1), _
ReadOnly:=False, _
Password:="", _
UpdateLinks:=3)
If Err = 0 Then
With WBSsource
'do stuff here
.Save
.Close True
End With
Else
msg = msg & FileNames(i, 1) & Chr(10)
On Error GoTo 0
End If
End If
Set WBSsource = Nothing
Next i
If Len(msg) > 0 Then
MsgBox "The Following Files Could Not Be Opened" & _
Chr(10) & msg, 48, "Error"
End If
End Sub
The problem now is I am using this to work on a Network drive, and as a result it cause pathing issues with the Connections/Edit Links part. Each of the files are stored on S:\... which as a result of using the Hyperlink formula, won't be able to find the source data. See below the example image of a file that as been opened through a hyperlink cell from my original workbook. When I go to update the Edit Links section of it, it shows these errors.
If I open that lettered drive in Windows Explorer and find the file, it works with no problems. Open, Update Values > Save > Close, it says unknown...
(but if I click Update values here they update correctly.)
If opened using a Hyperlink formula in a cell (Also directing to S:\..) it says it contains links that cannot be updated. I choose to edit links and they're all "Error: Source not found". The location on them also starts off with \\\corp\... and not S:\.
Anyway to fix this? Apologies for the long winded question.
I'm adding this as an answer as it contains code and is a bit long for a comment.
I'm not sure if it's what you're after though.
The code will take the mapped drive and return the network drive, or visa-versa for Excel files. DriveMap is the variable containing the final string - you may want to adapt into a function.
Sub UpdatePath()
Dim oFSO As Object
Dim oDrv As Object
Dim FileName As String
Dim DriveMap As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileName = Range("A1")
If InStr(oFSO.GetExtensionName(FileName), "xls") > 0 Then
For Each oDrv In oFSO.drives
If oDrv.sharename <> "" Then
'Changes \\corp\.... to S:\
If InStr(FileName, oDrv.sharename) = 1 Then
DriveMap = Replace(FileName, oDrv.sharename, oDrv.Path)
End If
'Changes S:\ to \\corp\....
' If InStr(FileName, oDrv.Path) = 1 Then
' DriveMap = Replace(FileName, oDrv.Path, oDrv.sharename)
' End If
End If
Next oDrv
End If
End Sub
I just spent a significant amount of time creating identical graphs in several dozen excel files (all containing identically formatted data,) and believe there has to be a more efficient way of completing what I've just done.
To simplify things, consider 50 excel documents with data in the same format. Does there exist a method of automatically:
Creating a simple line graph
Adding axis labels, a chart label, removing horizontal grid lines
Including a trend line/R^2 value
Saving the new workbook to a certain location with "_graphed" appended to the filename
Would this be something that an Excel VBA could be used for?
For this sort of problem I would start by recording a macro of the steps you take manually into a personal macro workbook. You can then look at the code produced by Excel and you may find that you don't need to make too many changes for this to be useful as a generic procedure.
After testing, if you wanted to take the automation one step further you could write a little procedure to loop through all of the Excel files in a directory and call your chart procedure for each file when it is open. I can dig out come code I wrote doing something similar if it will help.
Update
Here is a thread where I have provided some code to loop through all of the files containing some given text (in this example ".pdf" but could just as easily be ".xls" to cover xlsx, xlsm etc).
Also this example prints out a list of the files it finds to a worksheet. This is a good start to test the results, but once this is okay you would need to replace the line:
Range(c).Offset(j, 0).Value = vFileList(i)
With some code to open that workbook and call your code to generate the chart. Let me know if you get stuck.
Further Update
I have reviewed the code referred to above and made a few improvements including an additional parameter for you to specify the name of a macro that you want to run against each of the workbooks opened (that meet the condition specified). The macro that you use in the call must exist in the workbook that you are calling all of the other workbooks from (e.g. if the chart macro is in your personal workbook then the code below should also be placed in your personal macro workbook):
Option Explicit
Sub FileLoop(pDirPath As String, _
Optional pPrintToSheet = False, _
Optional pStartCellAddr = "$A$1", _
Optional pCheckCondition = False, _
Optional pFileNameContains = "xxx", _
Optional pProcToRunOnWb)
On Error GoTo PrintFileList_err
' Local constants / variables
Const cProcName = "FileLoop"
Dim vFileList() As String ' array for file names
Dim i As Integer ' iterator for file name array
Dim j As Integer ' match counter
Dim c As String
' variables for optional param pProcToRunOnWb
Dim vFullPath As String
Dim vTmpPath As String
Dim wb As Workbook
vFullPath = Application.ThisWorkbook.FullName
vFileList = GetFileList(pDirPath)
c = pStartCellAddr
j = 0
For i = LBound(vFileList) To UBound(vFileList)
' if condition is met (i.e. filename cotains text or condition is not required...
If pCheckCondition And InStr(1, vFileList(i), pFileNameContains, vbTextCompare) > 0 _
Or Not pCheckCondition Then
' print name to sheet if required...
If pPrintToSheet Then
Range(c).Offset(j, 0).Value = vFileList(i)
j = j + 1 ' increment row offset
End If
' open wb to run macro if required...
If pProcToRunOnWb <> "" Then
Application.DisplayAlerts = False ' set alerts off so that macro can run in other wb
vTmpPath = pDirPath & "\" & vFileList(i)
Set wb = Workbooks.Open(Filename:=vTmpPath)
Workbooks(wb.Name).Activate
Application.Run "'" & vFullPath & "'!" & pProcToRunOnWb
wb.Close (True) ' save and close workbook
Application.DisplayAlerts = True ' set alerts back on
End If
End If
Debug.Print vFileList(i)
Next i
' clean up
Set wb = Nothing
PrintFileList_exit:
Exit Sub
PrintFileList_err:
Debug.Print "Error in ", cProcName, vbCrLf, "Err no: ", Err.Number, _
vbCrLf, "Err Description: ", Err.Description
Resume Next
End Sub
Function GetFileList(pDirPath As String) As Variant
On Error GoTo GetFileList_err
' Local constants / variables
Const cProcName = "GetFileList"
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim c As Double ' upper bound for file name array
Dim i As Double ' iterator for file name array
Dim vFileList() As String ' array for file names
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(pDirPath)
c = objFolder.Files.Count
i = 0
ReDim vFileList(1 To c) ' set bounds on file array now we know count
'Loop through the Files collection
For Each objFile In objFolder.Files
'Debug.Print objFile.Name
i = i + 1
vFileList(i) = objFile.Name
Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
GetFileList = vFileList
GetFileList_exit:
Exit Function
GetFileList_err:
Debug.Print "Error in ", cProcName, vbCrLf, "Err no: ", Err.Number, _
vbCrLf, "Err Description: ", Err.Description
Resume Next
End Function
You can call this from another macro or from the immediate window (ctrl+G) with the parameters required e.g. to get all files containing '.xls', and run a macro named 'your_macro_name_here' the code would be:
call FileLoop("C:\Users\Prosserc\Dropbox\Docs\Stack_Overflow\Test", False, "", True, ".xls", "your_macro_name_here")
Obviously change the path in the first parameter to point to the directory containing the files that you want to run the macro against.
There is a library called Xlsxwriter for both python and perl which allows for the automation of chart generation. For some sample python code, see my post here.
In VBA Help for the RefersTo Property, they give this example of listing all the Names in a Wkb (fleshed out so you can run it as is)
Sub showNames()'from VBA Help for "RefersTo"
Dim newSheet As Worksheet
Set newSheet = Worksheets.Add
Dim i As Long, nm As Name
i = 1
For Each nm In ActiveWorkbook.Names
newSheet.Cells(i, 1).Value = nm.Name
newSheet.Cells(i, 2).Value = "'" & nm.RefersTo
i = i + 1
Next
newSheet.Columns("A:B").AutoFit
End Sub
When I run that on my current project, it turns up many Names that I thought were long gone. But here they are still hanging around and referring to places that no longer exist. I think this is what's slowing up my system and I'd love to get rid of those Names, but they don't show up in the Define Name window so where do I find them?
edit: Meant to mention that the Links item is greyed out for this Wbk.
Update
option 1
A manual method to delete corrupt names using R1C1 (I can recall JKP stating on another forum he had code to do this but he wasn't prepared to provide it for free)
Select Tools, Options and click the General tab.
Click the check box next to "R1C1 Reference Style", so that you change the current setting.
Press OK.
Excel will prompt you to change the name of any name (in all open workbooks!) that contains illegal characters.
Select Insert, name, define to delete the newly renamed names.
Set the R1C1 Reference style back the way you prefer using Tools, Options, General.
option 2
Chris Neilsen posted this at Any chance to delete programatically corrupt ranged names (with spaces) in Excel (2007/2010)
But, here's a possible alternative: SaveAs your workbook as a .xlsm
You should get a dialog complaining about invalid names, with a option
to rename and a Ok to All button. Once saved, close and reopen the
file, Save As an .xls and you should be good to go
Initial Post
Download Name Manager which is the stand out addin by Jan Karel Pieterse and Charles Williams for managing names
It will handle Names that
now error out as the ranges have been deleted (your issue),
link to other Workbooks,
are now corrupt
Plus it will convert global names to local sheet names, and vice versa and so on
- Updated Answer -
Since you know the names of the invalid ranges but can't see them in the Name Manager, you can try to delete them manually from the VBA Immediate window. The name you gave GrPix!patternListRange indicates a worksheet name so you should be able to delete it by typing
ActiveWorkbook.Names("GrPix!patternListRange").Delete
or
Sheets("GrPix").Names("patternListRange").Delete
in the Immediate Window
Original Answer
Have you tried deleting the invalid names via code? i.e.
For Each nm In ActiveWorkbook.Names
If InStr(nm.RefersTo, "OldFileName.xls") > 0 Then
nm.Delete
End If
Next nm
Here are two more solutions that may work for others searching on this topic, but these still don't fix my own particular Workbook.
I'm still looking.
This is from Aaron Blood and shows the R1C1 method mentioned by brettdj:
Sub RemoveDemonLinks()
Dim wbBook As Workbook
Dim nName As Name
Dim i As Long
Set wbBook = ActiveWorkbook
i = 0
If wbBook.Names.Count > 0 Then
With Application
.ReferenceStyle = xlR1C1
.ReferenceStyle = xlA1
End With
For Each nName In wbBook.Name
If InStr(nName.RefersTo, "#REF!") > 0 Then nName.Delete
i = i + 1
Next nName
If i > 0 Then MsgBox i & " corrupted names was deleted from " & wbBook.Name
End If
End Sub
This is from MS Help
' Module to remove all hidden names on active workbook
Sub Remove_Hidden_Names()
' Dimension variables.
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant
' Loop once for each name in the workbook.
For Each xName In ActiveWorkbook.Names
'If a name is not visible (it is hidden)...
If xName.Visible = True Then
Vis = "Visible"
Else
Vis = "Hidden"
End If
' ...ask whether or not to delete the name.
Result = MsgBox(prompt:="Delete " & Vis & " Name " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Which refers to: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNo)
' If the result is true, then delete the name.
If Result = vbYes Then xName.Delete
' Loop to the next name.
Next xName
End Sub