I have an excel sheet where I am trying to create a named range dynamically in VBA. Maybe there's a better way to do it, but the existing way I am using should work based on multiple articles and tickets I have read on the topic. Using this method fails for me because the processing stop without an error when running this code. The range gets created or deleted on the line where processing stops, but of course I need processing to continue through the rest of the code. You should be able to replicate this issue in any excel sheet if you use this code snippet and run the test caller in testsub():
Option Explicit
Sub testsub()
Call SetDataRange("TestRange", ActiveWorkbook.Sheets("Sheet1"), 1, 2)
End Sub
Sub SetDataRange(RangeName As String, TargetSheet As Worksheet, LeftColumn As Integer, RightColumn As Integer)
On Error GoTo Fail
Dim WB As Workbook
Dim CRLastCell As Range
Dim rngDataRange As Range
Set WB = ActiveWorkbook
With TargetSheet
Set CRLastCell = .Cells(.Rows.Count, "A").End(xlUp)
Set rngDataRange = .Range(.Cells(1, LeftColumn), .Cells(CRLastCell.Row, RightColumn))
On Error Resume Next
Debug.Assert False ' Forcing a break for debug purposes. The next line will cause the processing to stop without an error if the named range exists
WB.Names.Item(RangeName & "_" & .Name).Delete
Err.Clear
On Error GoTo Fail
Debug.Assert False ' Forcing a break for debug purposes. The next line will cause the processing to stop without an error
WB.Names.Add Name:=RangeName & "_" & .Name, RefersTo:="=" & .Name & "!" & rngDataRange.Address, Visible:=True
End With
Debug.Print RangeName & "_" & TargetSheet.Name & " " & ActiveWorkbook.Names.Item(RangeName & "_" & TargetSheet.Name).RefersTo
Exit Sub
Fail:
Debug.Print "Error: " & vbCrLf & Err.Number & vbCrLf & Err.Description
End Sub
This is not my original code, but a recreation of the code I placed in a new workbook for simplest reproducible conditions.
Thanks
As suggested by EvR, I removed the code which was trying to delete the named range, thereby utilizing the feature in the names.add function that overwrites an existing name. This bypasses the issue without any undesired side effects, so I will consider this an answer to the question.
Related
i do have several hundred of excel files. Every excel file contains a makro in the "workbooks_open" method. I want to open all these files, comment out the code, save and close the file.
a loop through all files with open/close is not a problem, but with the changing of the vba code i have no idea.
many thanks in advance!
Sub test()
Dim Path as string = "C:\123\"
Dim cDir As String
cDir = Dir(Path & "*.xlsx")
Do While cDir <> ""
Application.DisplayAlerts = False
'### open
Workbooks.Open Filename:=Path & cDir
'### here i want to deactivate/comment out the makro in the workbook_open method
'### save
ActiveWorkbook.Save
ActiveWorkbook.Saved = True
'### close
ActiveWorkbook.Close False
cDir = Dir
Loop
End Sub
To access the code of a workbook using code, you need to allow access to the VBE via code - see https://stackoverflow.com/a/11680865/7599798 how to do so.
You access all the coding stuff of a workbook using its VBProject-Property.
If you want to use the Types and Constants of the Project, add a reference to Microsoft Visual Basic for Applications Extensibility
The VBProject contains a collection of Components VBComponents, this is the list you see in the VBE in the project window, it contains all modules, classes and forms.
The Workbook-Module has the Name ThisWorkbook and it's type = 100 (use vbext_ct_Document if you have added the mentioned reference)
To access the code of a module, use the property CodeModule of the component.
The lines of code can be fetched using the lines-property of CodeModule, you need to pass two parameters (startrow and numbers of rows).
The lines-property is read only, if you want to change code, you can use the methods InsertLines, DeleteLines and ReplaceLines
Have a look to the next routine to see how it could look like. It will simply replace the Workbook_Open()-routine with Workbook_Open_BACKUP() so it will no longer fire when the workbook is opened.
Sub RemoveOnOpen(wb As Workbook)
Dim i As Long
With wb.VBProject
For i = 1 to .VBComponents.Count
' Debug.Print .VBComponents(i).Type, .VBComponents(i).Name
If .VBComponents(i).Type = vbext_ct_Document And .VBComponents(i).Name = "ThisWorkbook" Then
Dim row As Long
For row = 1 To .VBComponents(i).CodeModule.CountOfLines
Dim module As CodeModule, line As String
Set module = .VBComponents(i).CodeModule
line = Trim(module.Lines(row, 1))
If Left(line, 27) = "Private Sub Workbook_Open()" Then
module.ReplaceLine row, Replace(line, "Workbook_Open()", "Workbook_Open_BACKUP()")
End If
Next
End If
Next i
End With
End Sub
Update: As T.M. noted, the name of the Workbook module may be different if used in a different language environment, you should check this.
I also added a Trim-statement when checking the code line for the Sub.
Please, use the next Sub. It should be called by the code iterating between all workbooks to be changed:
Sub ComSpecSub(wb As Workbook, moduleName As String, strLine As String)
Dim objThisWb As VBComponent, CodeM As CodeModule, i As Long, j As Long
Set objThisWb = wb.VBProject.VBComponents("ThisWorkbook")
Set CodeM = objThisWb.CodeModule
If CodeM.Find(strLine, 1, 1, CodeM.CountOfLines, 1, False) = True Then
For i = 1 To CodeM.CountOfLines
If InStr(CodeM.lines(i, 1), strLine) > 0 Then
If left(CodeM.lines(i, 1), 1) = "'" Then Exit Sub 'already commented...
'if running the code again
Do While i + j <= CodeM.CountOfLines
CodeM.ReplaceLine i + j, "'" & CodeM.lines(i + j, 1)
If InStr(CodeM.lines(i + j, 1), "End Sub") > 0 Then Exit Do
j = j + 1
Loop
End If
Next i
End If
End Sub
The above code needs a reference to 'Microsoft Visual Basic for Applications Extensibility'
It should be called from your code as:
ComSpecSub ActiveWorkbook, "ThisWorkbook", "Private Sub Workbook_Open()"
ActiveWorkbook.Close True
If adding the required reference looks problematic, please firstly run the next code, which will add it automatically:
Sub addExtenssibilityReference()
'Add a reference to 'Microsoft Visual Basic for Applications Extensibilty 5.3':
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
End Sub
Language independant & no loops
In addition to the valid answers of #FunThomas (following his renaming idea) and #FaneDuru I demonstrate an approach with two benefits:
the component ThisWorkbook can be found independantly from regional language settings via wb.VBProject.VBComponents(wb.CodeName),
as workbooks can be referenced not only by their name string which may differ for other languages than English,
but also via a workbook's wb.CodeName property (similar for sheets);
the effective procedure start row can be found in one go via
.ProcBodyLine(srchProcName, 0), where the zero input defines a sub or function procedure kind (other than Get|Let|Set props);
Further hints:
Needs a library reference to Microsoft Visual Basic for Applications Extensibility 5.3 (c.f. also #FaneDuru's progamatical approach).
Generally replacing a code line by another should consider possible line breaks ( _) resulting in two or several lines, too; due to the brevity of the procedure I don't assume a line break before "Workbook_Open" (like e.g. `Private Sub _".
Sub BackUp(wb as WorkBook, Optional ByVal srchProcName As String = "Workbook_Open")
'Purp: change a given procedures name in ThisWorkbook (e.g. "Workbook_Open") by adding "_BACKUP"
'0) Define backup name string
Dim backupName As String: backupName = srchProcName & "_BACKUP"
'1) Access ThisWorkbook directly by its CodeName (independant from regional language settings)!
Dim myComp As VBIDE.VBComponent
Set myComp = wb.VBProject.VBComponents(wb.CodeName)
'Debug.Print "** Code(Name): " & wb.CodeName & " (Local Name: " & myComp.Name & ")"
'2) Search directly for the effective start row of srchProcName (e.g. "Workbook_Open")
Dim effectiveRow As Long
With myComp.CodeModule ' the component's code module
On Error Resume Next
effectiveRow = .ProcBodyLine(srchProcName, 0) ' find effective row of search procedure
Select Case Err.Number
Case 0
Dim newContent As String
newContent = Replace(Trim(.Lines(effectiveRow, 1)), srchProcName, backupName)
.ReplaceLine effectiveRow, newContent
Debug.Print "** " & wb.Name & vbNewLine & "" _
; " Changed procedure '" & srchProcName & "' in row " & effectiveRow & _
" to " & backupName
Case 35
Debug.Print "** " & wb.Name & vbNewLine & _
" Error " & Err.Number & " " & Err.Description & vbNewLine & _
" Procedure '" & srchProcName & "' doesn't exist!" & vbNewLine & _
" (Possibly already 'backupped')": Err.Clear
Case Else
Debug.Print "** " & wb.Name & vbNewLine & _
" Error " & Err.Number & " " & Err.Description: Err.Clear
End Select
End With
End Sub
Example output in VB Editor's immeditate window
Inserting Backup ActiveWorkbook or a pre-set Backup wb in your code should suffice to rename existing "Workbook_Open" procedures by a "_BACKUP" suffix.
** ExampleWorkbook147.xlsm
Changed procedure 'Workbook_Open' in row 8 to Workbook_Open_BACKUP
In reply of #T.M comment and nice answer:
The next solution uses Find, which besides returning True when the searched string has been found, it modifies the StartLine parameter, if used as a variable. Then, since the question also involves commenting all the procedure lines, not only changing the declaration line, it will do it, without iteration, too:
Sub findProcThisWb(Optional wb As Workbook, Optional strLine As String = "Workbook_Open")
Dim thisWBCodeM As CodeModule, foundLine As Long, ProcExists As Boolean, arrPr
Dim procName As String, strCodeLine As String, strProcedure As String, strComProc As String
If wb Is Nothing Then Set wb = ThisWorkbook
Set thisWBCodeM = wb.VBProject.VBComponents(wb.CodeName).CodeModule
foundLine = 1 'initialize the line where from Find starts searching
Dim noLines As Long 'it will keep the found procedure number of lines
With thisWBCodeM
' ProcExists = .Find(strLine, foundLine, .CountOfLines, 1, -1, False, False) ' OP
ProcExists = .Find(strLine, foundLine, 1, .CountOfLines, -1, False, False) ' << Edit/2022-01-24 corr. argument order
Debug.Print foundLine: ' the line of the found procedure, if it has been found!
If ProcExists Then
strCodeLine = .lines(foundLine, 1) 'return the whole line
Debug.Print strCodeLine 'the whole line where the searched string has been found
procName = .ProcOfLine(foundLine, vbext_pk_Proc): Debug.Print "Proc name = " & procName
noLines = .ProcCountLines(procName, vbext_pk_Proc): Debug.Print "Number of procedure lines = " & noLines
strProcedure = .lines(foundLine, noLines): Debug.Print "The whole procedure:" & vbLf & strProcedure
arrPr = Split(strProcedure, vbLf)
strComProc = "'" & Join(arrPr, vbLf & "'"): Debug.Print "The whole commented procedure:" & vbLf; strComProc
'Delete the actual procedure lines:
.DeleteLines foundLine, noLines - 1 ' Edit 2022-01-24: -1
'Add the commented procedure code (from string, but not in the same place, after the declaration lines):
.AddFromString strComProc
End If
End With
End Sub
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 got a need to open some Excel files and "pause" then close them. In this process I run one macro on opening, and another on closing. The opening one works fine because it is done as each file is opened. But the closing part of the code I can't get it to run the correct macro. They have the same names, but the file contests are different, and what the macro does per file is different.
This is the gist of what I'm doing now
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
path = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
filename2018P1 = "2018 P1.xlsm"
Set xlbook2018P1 = xlApp.WorkBooks.Open(path & filename2018P1)
' Run Macro
xlApp.Run "AutoRefresh"
filename2018P3 = "P3 2018 HRR.xlsm"
Set xlbook2018P3 = xlApp.WorkBooks.Open(path & filename2018P3)
'Run Macro
xlApp.Run "AutoRefresh"
'My "pause"
WScript.Echo ("All Files were" & Chr(013) & _
"opened and refreshed, update ppt before OK" & Chr(013) & _
" DO NOT CLICK OK" & Chr(013))
'==========================
'Below is the trouble spot.
'==========================
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
The first part works fine, but trying to run the file's respective AutoPublish macro does not. The code works fine if I leave out that Run line. (The real file names have spaces and I had to add the single quotes to get it to accept the filename.)
What it appears to be doing is using the macros from the last file opened, not the one it's directed to use it the run line. I think I need a way to "select" the correct file, or give it focus so the macro could run without an explicit filename argument, which it appears to be ignoring anyway.
EDIT:
Solution was:
xlbook2018P1.Activate ' This fixed it, I think
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlbook2018P3.Activate
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
When tackling similar tasks, I usually work around by implementing a master Excel file first, and call a sub in this master file via VBS. The advantage to me seems it is way easier to fullfill all tasks in the VBA of the master file rather than having to code all that in VBS.
Create a master file, e.g. "Master.xlsm", list all your files you need to open on a sheet named "Files" in column A, starting in row 1.
Insert a module and place the following sub in this module:
Sub Main()
Dim strPath As String
Dim strFile As String
Dim lRow As Long
Dim i As Long
Dim k As Integer
Dim n As Long
Dim wb(1 To 3) As Workbook
Dim wbTest As Workbook
Set wbMaster = ThisWorkbook
strPath = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
'Check how many files you need to open
With Sheets("Files")
lRow = Sheets("Files").Range("A" & .Rows.Count).End(xlUp).Row
End With
'open all available files
For i = 1 To lRow
Workbooks.Open (wbMaster.Sheets("Files").Range("A" & i).Value)
Next
'now run the two macros in each open file
For k = 2 To Workbooks.Count 'this will work only if your master file is the only one open when starting the sub!
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoRefresh"
DoEvents
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoPublish"
DoEvents
Next
'and close all files previously opened except for the master file
For n = Workbooks.Count To 2 Step -1
Workbooks(n).Close False
Next
End Sub
It seems like a possible explanation for what you're seeing is that your AutoPublish macro refers to ActiveWorkbook and not the safer ThisWorkbook. If another workbook is active when it's called that could lead to unexpected results.
I have a value (variant) strCompany in my workbook. I would like to determine if this value exists in column A of another workbook, tmp_workbook. If it does not exist there should be a message box. Does the following code make sense (I define the variables tmp_workbook and strCompany earlier in my code)? If not perhaps you can suggest a better way?
On Error GoTo ErrorHandler
Set value_exists_in_table = tmp_workbook.ActiveSheet.Range("A1:A100000").Find(strCompany)
ErrorHandler:
Select Case Err.Number
Case 9, 91
MsgBox "The company " & strCompany & " was not found."
Exit Sub
End Select
The Range.Find method inherits many parameters from the last time it was used; commonly by the user on the worksheet. You should explicitly specify several more commonly used parameters like LookAt:xlWhole or LookAt:xlPart and LookIn:=xlValues or LookIn:=xlFormulas.
I typically stay away from .Find for exact matches in a single row or column. The Excel Application object's native MATCH function does an excellent job of locating a value.
dim rw as variant
with worksheets("Sheet1")
rw = application.match(strCompany, .Columns(1), 0)
if not iserror(rw) then
value_exists_in_table = .cells(rw, 1).value
debug.print value_exists_in_table & " found in row " & rw
else
debug.print "The company " & strCompany & " was not found."
end if
end with
Here's the basic problem: I am writing an Excel macro and I would like to use the worksheet code names to try to eliminate any errors down the road. I can use the code name for Sheet1 and it works fine, but when I try to use the other codes, like Sheet3 or Sheet7 the editor doesn't recognize them and if I run the macro Excel kicks up an error telling me that my "variable is not defined".
For example:
Option Explicit
Sub Test()
Dim SheetObject As Worksheet
Dim SheetObject2 As Worksheet
Set SheetObject = Sheet1
Set SheetObject2 = Sheet3
MsgBox (SheetObject.Name)
MsgBox (SheetObject2.Name)
End Sub
If I comment out any code referring to SheetObject2 the macro runs correctly. If I put them in I get the errors. I definitely have a Sheet3, and the code name is definitely Sheet3. I've looked around Google all day and can't seem to come up with any solutions, any help would be great.
Thanks in advance,
Jesse
My last employer collected data and created national statistics. Much of that data came in the form of Excel workbooks so I have had a lot of relevant experience.
If you are running your own macro and if this is a one-off exercise then tests like this may be adequate:
Debug.Assert WbookTgt.WsheetTgt.Range("A1").Value = "Date"
Many languages have an Assert statement as a development aid; this is the VBA version. If the assertion is not true, the macro will stop with this statement highlighted.
If this approach is not adequate, you should consider developing parameterised macros that perform checking and updating tasks. I have looked through some of my old macros but most would not be intelligible to someone new to VBA. I have extracted code to create two macros which I hope will give you some ideas.
Macro 1 - OpenWorkbook
Organisations that regularly supply data often use names like: "Xxxxx 1409.xlsx" and "Xxxxx 1410.xlsx" for the September and October versions of their data. You could, for example, update the macro each month for the latest name or you could change the filename to a standard value. Either of these possibilities would be a nuisance and I would be particularly opposed to the second idea because I like to archive all the workbooks I have processed.
OpenWorkbook() uses the Dir statement to search a folder for a file that matches a template such as “Xxxxx*.xls*”. If a single file matches this template, the macro opens the workbook and returns a reference to it.
Macro 2 – CheckWorksheets
You may have noticed that some VBA routines have a fixed number of parameters while others have a variable number of parameters. For example, the following are all valid calls of CheckWorksheets:
If CheckWorksheets(WbookTgt, WbookThis, “Name1”) then
If CheckWorksheets(WbookTgt, WbookThis, “Name1”, “Name2”) then
If CheckWorksheets(WbookTgt, WbookThis, “Name1”, “Name2”, “Name3”) then
CheckWorksheets has three parameters. The first two are workbook references. The third is ParamArray SheetName() As Variant. Any parameter after the first two is placed in array SheetName which can be as large as necessary. Here all the trailing parameters are strings but they could be of any type.
I can use OpenWorkbook to open this month’s version of the source file and then use CheckWorksheets to confirm all the worksheets required by my macro are present.
Worksheet Errors”
These two macros require a worksheet Errors be present in a specified workbook. If the macros detect an error, they add a detailed error message to this worksheet. I have found this a convenient technique for capturing the details of any errors.
Macros Demo1 and Demo2
I have included two macros that demonstrate the use of these macros with workbooks on my system. If you amend Demo1 and Demo2 to operate on some of your workbooks, you should get an idea of what OpenWorkbook and CheckWorksheets can do for you.
Come back with questions as necessary but the more you can decipher OpenWorkbook and CheckWorksheets yourself, the faster you will develop your own skills
Option Explicit
Sub Demo1()
Dim Path As String
Dim WbookThis As Workbook
Dim WbookTgt As Workbook
' Application.ThisWorkbook identifies the workbook containing this macro.
Set WbookThis = Application.ThisWorkbook
' I find it convenient to place my target workbooks in the folder
' holding the workbook containing the macro(s).
Path = WbookThis.Path
Set WbookTgt = OpenWorkbook(Path, "Combined*.xls*", WbookThis)
If WbookTgt Is Nothing Then
' Detailed error message already recorded in "Errors"
Call MsgBox("Wokbook failed checks", vbOKOnly)
Else
With WbookTgt
Debug.Print .Path & "\" & .Name & " opened."
.Close SaveChanges:=False
End With
End If
End Sub
Sub Demo2()
Dim Path As String
Dim WbookThis As Workbook
Dim WbookTgt As Workbook
' Application.ThisWorkbook identifies the workbook containing this macro.
Set WbookThis = Application.ThisWorkbook
' I find it convenient to place my target workbooks in the folder
' holding the workbook containing the macro(s).
Path = WbookThis.Path
Set WbookTgt = OpenWorkbook(Path, "Combined 2.04.xls*", WbookThis)
If WbookTgt Is Nothing Then
' Detailed error message already recorded in "Errors"
Call MsgBox("Wokbook failed checks", vbOKOnly)
Exit Sub
End If
With WbookTgt
If Not CheckWorksheets(WbookTgt, WbookThis, "Critical Path", "Dyn Dims") Then
Call MsgBox("Wokbook failed checks", vbOKOnly)
.Close SaveChanges:=False
Exit Sub
End If
Debug.Print .Path & "\" & .Name & " contains worksheets Critical and Dym Dims"
.Close SaveChanges:=False
End With
End Sub
Function CheckWorksheets(ByRef WbookTgt As Workbook, ByRef WbookError As Workbook, _
ParamArray SheetName() As Variant) As Boolean
' * Return True if WbookTgt contains every specified worksheet.
' * WbookTgt is the workbook to be checked
' * WbookError identifies the workbook containing worksheet "Error" to which any
' error message will be added.
' * SheetName() is an array of worksheet names.
Dim ErrorMsg As String
Dim FoundError As Boolean
Dim FoundSheet() As Boolean
Dim FoundSheetsCount As Long
Dim InxName As Long
Dim InxWsheet As Long
Dim NotFoundSheetsCount As Long
Dim RowErrorNext As Long
Dim SheetNamesFound As String
' Size FoundSheet to match SheetName. Array elements initialised to False
ReDim FoundSheet(LBound(SheetName) To UBound(SheetName))
FoundSheetsCount = 0
NotFoundSheetsCount = 0
With WbookTgt
For InxName = LBound(SheetName) To UBound(SheetName)
NotFoundSheetsCount = NotFoundSheetsCount + 1 ' Assume not found until found
For InxWsheet = 1 To .Worksheets.Count
If SheetName(InxName) = .Worksheets(InxWsheet).Name Then
FoundSheet(InxName) = True
FoundSheetsCount = FoundSheetsCount + 1
NotFoundSheetsCount = NotFoundSheetsCount - 1
Exit For
End If
Next
Next
End With
If NotFoundSheetsCount = 0 Then
CheckWorksheets = True
Exit Function
End If
SheetNamesFound = ""
ErrorMsg = WbookTgt.Path & "\" & WbookTgt.Name & " does not contain "
If NotFoundSheetsCount = 1 Then
ErrorMsg = ErrorMsg & "this expected worksheet:"
Else
ErrorMsg = ErrorMsg & "these expected worksheets:"
End If
For InxName = LBound(SheetName) To UBound(SheetName)
If Not FoundSheet(InxName) Then
ErrorMsg = ErrorMsg & vbLf & " " & SheetName(InxName)
Else
SheetNamesFound = SheetNamesFound & vbLf & " " & SheetName(InxName)
End If
Next
If FoundSheetsCount = 0 Then
' No need to add list of found sheet names
Else
ErrorMsg = ErrorMsg & vbLf & "but does contain "
If FoundSheetsCount = 1 Then
ErrorMsg = ErrorMsg & "this expected worksheet:"
Else
ErrorMsg = ErrorMsg & "these expected worksheets:"
End If
ErrorMsg = ErrorMsg & SheetNamesFound
End If
With WbookError
With .Worksheets("Errors")
RowErrorNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
With .Cells(RowErrorNext, "A")
.Value = Now()
.VerticalAlignment = xlTop
End With
.Cells(RowErrorNext, "B").Value = ErrorMsg
End With
End With
CheckWorksheets = False
End Function
Function OpenWorkbook(ByVal Path As String, ByVal FileTemplate As String, _
ByRef WbookError As Workbook) As Workbook
' * If Path & FileTemplate identifies a single workbook, open it and return
' it as an object. If Path & FileTemplate does not represent a single
' workbook, report the problem in worksheet Errors and return Nothing.
' * WbookError identifies the workbook containing worksheet "Error".
' * Path must be the name of the folder in which the required workbook is located
' * FileTemplate can either be a specific filename or can contain wild cards
' providing only one file matches the template.
' * WbookError identifies the workbook containing worksheet "Error" to which any
' error message will be added.
Dim ErrorMsg As String
Dim FileNameCrnt As String
Dim FileNameMatch As String
Dim RowErrorNext As Long
FileNameMatch = Dir$(Path & "\" & FileTemplate, vbNormal)
If FileNameMatch = "" Then
' No matches found
ErrorMsg = "Template " & Path & "\" & FileTemplate & " does not match any file"
Else
' At least one match.
' If only one match, its name is in FileNameMatch
Do While True
FileNameCrnt = Dir$
If FileNameCrnt = "" Then
' No more matches
Exit Do
End If
' A second or subsequent match has been found.
If FileNameMatch <> "" Then
' This is the second match.
' Initialise error message and report name of first match
ErrorMsg = "Template " & Path & "\" & FileTemplate & " matches more than one file:" & _
vbLf & " " & FileNameMatch
FileNameMatch = "" ' No single match
End If
' Add name of current match to error message
ErrorMsg = ErrorMsg & vbLf & " " & FileNameCrnt
Loop
End If
If FileNameMatch = "" Then
' No single match found.
' ErrorMsg contains an appropriate error message
With WbookError
With .Worksheets("Errors")
RowErrorNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
With .Cells(RowErrorNext, "A")
.Value = Now()
.VerticalAlignment = xlTop
End With
.Cells(RowErrorNext, "B").Value = ErrorMsg
Set OpenWorkbook = Nothing
End With
End With
Else
' Single match found
Set OpenWorkbook = Workbooks.Open(Path & "\" & FileNameMatch)
End If
End Function
Response to extra question
VBA has nothing quite as convenient as VB's Try but it does have some error handling under programmer control.
If you use a command such as:
Worksheets("Sheet2").Delete
the user will be asked to confirm the deletion. To avoid this, use:
Application.DisplayAlerts = False
Worksheets("Sheet2").Delete
Application.DisplayAlerts = True
I have seen code with Application.DisplayAlerts = False at the start of a macro which means no alert will be displayed for the user's attention even if the pogrammer was not expecting it. By bracketing the Delete, I ensure only the alert I was expecting is suppressed.
Consider:
Sub OpenFile()
Dim InputFileNum As Long
InputFileNum = FreeFile
Open "Dummy.txt" For Input As InputFileNum
Debug.Print "File successfully opened"
Close InputFileNum
End Sub
The file "Dummy.txt" does not exist so the macro will stop on the Open statement.
You will sometimes see code like this:
Sub OpenFile()
Dim InputFileNum As Long
On Error GoTo ErrorCode
InputFileNum = FreeFile
Open "Dummy.txt" For Input As InputFileNum
Call MsgBox("File successfully opened", vbOKOnly)
Close InputFileNum
Exit Sub
ErrorCode:
Debug.Print "Unexpected error: " & Err.Number & " " & Err.Description
End Sub
Here I have provided a general handler for any error condition that may occur. I do not approve although I accept that this is slightly better than having the non-technical user seeing the faulty statement highlighted. The trouble is any error will result in the same unhelpful error message.
I never include error handling during development. If an error occurs, I want the macro to stop on the faulty statement so I can consider how to avoid the error. Here I should check the file exists before attempting to open it. I prefer something like this:
Sub OpenFile()
Dim FileSysObj As Object
Dim InputFileNum As Long
On Error GoTo ErrorCode
Set FileSysObj = CreateObject("Scripting.FileSystemObject")
If Not FileSysObj.FileExists("Dummy.txt") Then
Call MsgBox("I am unable to find ""Dummy.txt"". List of helpful suggestions.", vbOKOnly)
Exit Sub
End If
InputFileNum = FreeFile
Open "Dummy.txt" For Input As InputFileNum
Call MsgBox("File successfully opened", vbOKOnly)
Close InputFileNum
Exit Sub
ErrorCode:
Debug.Print "Unexpected error: " & Err.Number & " " & Err.Description
End Sub
I have including checking code for the error I expect. If the file does not exist, I have displayed a message which I hope will help the user fix the problem for themselves.
Sometimes you cannot avoid an error. To test the code below, I created file Dummy.txt but set the "Read access denied" flag. There is no easy method (to my knowledge) for a VBA macro to test this flag. I have a general handler for unexpected errors but I switch it off for the Open statment so I can include specific code for open failures. I have removed the code that uses FileExists() to test if Dummy.txt exists because it is easier to include it with the other open file error tests.
Sub OpenFile()
Dim FileSysObj As Object
Dim InputFileNum As Long
On Error GoTo ErrorCode ' General handler for unexpected errors
InputFileNum = FreeFile
Err.Clear
On Error Resume Next ' Record error in Err object and continue
Open "Dummy.txt" For Input As InputFileNum
Select Case Err.Number
Case 0
' No error.
Case 53 ' File does not exist
Call MsgBox("I am unable to find ""Dummy.txt"". List of helpful suggestions.", vbOKOnly)
Exit Sub
Case 75 ' Path/File access error
Call MsgBox("It appears file ""Dummy.txt"" exists but I do not have permission to read it.", vbOKOnly)
Exit Sub
Case Else
Call MsgBox("My attempt to open ""Dummy.txt"" failed with an unexpected error condition" & vbLf & _
" " & Err.Number & " " & Err.Description, vbOKOnly)
Exit Sub
End Select
On Error GoTo ErrorCode ' Restore general handler for unexpected errors
Call MsgBox("File successfully opened", vbOKOnly)
Close InputFileNum
Exit Sub
ErrorCode:
Debug.Print "Unexpected error: " & Err.Number & " " & Err.Description
End Sub
Visit http://support.microsoft.com/kb/146864 for a long list of error codes and more information about error handling.