Trouble referencing sheet code names - excel

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.

Related

Excel macro to insert a value into mutiple excel files

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

deactivate/comment out makros in a lot of excel files

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

Parameter transmission from Excel into Macro

I am making a Macro in VBA (Excel 2016 32bit + Windows 10 Pro) that fires when Workbook.NewSheet event occurs.
This Macro must rename Sheet.CodeName property of every new sheet.
The problem is that when I run my Macro in breaking mode, step by step, it works perfectly.
But it can’t rename Sheet.CodeName property after VB Editor (VBE) is closed. Simply Sheet.CodeName property is empty, so Macro doesn’t know what sheet must have to renamed. If I open VBE and, doing nothing, close it again, Macro runs rightly.
And next, this Macro works correctly with Workbook.Open and Workbook.SheetChange events. Only Workbook.NewSheet event gives a trouble.
Give me a suggest, please, if you know, how I can improve parameter transmit from Excel to my Macro behind closed VBE.
Hi!
Thank You for want to helping me!
The code is very easy.
The goal is - get properly value of sh_CodeName property in message window
when VBE is closed.
Current code:
Private Sub Workbook_NewSheet(ByVal sh As Object)
NewSheet sh
End Sub
Option Explicit
Sub NewSheet(ByVal sh As Object)
Dim sh_CodeName As String, sh_Name As String, i As Integer
sh_CodeName = sh.CodeName: sh_Name = sh.Name
MsgBox "Code Name - " & sh_CodeName & vbCrLf & "Name - " & sh_Name, vbOKOnly, "MESSAGE FROM WorkBook.NewSheet"
End Sub
It seems that sh.codename is not available after adding a new sheet as long as one has not accessed the VBA project. Maybe someone else hase more on this.
This code works for me but has the disadvantage that you need to trust access to the VBA project object model.
Sub NewSheet(ByVal Sh As Object)
Dim sh_CodeName As String, sh_Name As String, i As Integer
sh_CodeName = ActiveWorkbook.VBProject.VBComponents(Sh.Name).Properties("_Codename")
sh_Name = Sh.Name
MsgBox "Code Name - " & sh_CodeName & vbCrLf & "Name - " & sh_Name, vbOKOnly, "MESSAGE FROM WorkBook.NewSheet"
End Sub
Even this simple macro will not give a codename when run with closed VBE
Sub TestAddIt()
Dim sh As Worksheet
Set sh = ActiveWorkbook.Worksheets.Add
MsgBox sh.Name & " - " & sh.CodeName
End Sub
PS: Another workaround could be to open the VBE and close it again but you still need access to the VBA project
Sub TestAddIt()
Dim Sh As Worksheet
Set Sh = ActiveWorkbook.Worksheets.Add
With Application.VBE.MainWindow
.WindowState = 1
.Visible = True
.Visible = False
End With
MsgBox Sh.Name & " - " & Sh.CodeName
End Sub
Update: This also worked for me.
Sub TestAddIt()
Dim Sh As Worksheet
Set Sh = ActiveWorkbook.Worksheets.Add
' Recompile the project
Application.VBE.CommandBars.FindControl(ID:=578).Execute
MsgBox Sh.Name & " - " & Sh.CodeName
End Sub
You help me with this statement.
sh_CodeName = ActiveWorkbook.VBProject.VBComponents(Sh.Name).Properties("_Codename")
I modified it slightly (Sh.CodeName instead of Sh.Name). And added a delay.
Sub Check_NewSheet(ByVal sh As Object)
Dim sh_CodeName As String, sh_Name As String, i As Integer
On Error Resume Next
sh_CodeName = ThisWorkbook.VBProject.VBComponents(sh.CodeName).Properties("_Codename")
If Err.number > 0 Then
i = 0
Do While sh_CodeName = ""
sh_CodeName = ThisWorkbook.VBProject.VBComponents(sh.CodeName).Properties("_Codename")
DoEvents
i = i + 1
Loop
End If
sh_Name = sh.Name
MsgBox "Code Name - " & sh_CodeName & vbCrLf & "Name - " & sh_Name & vbCrLf & _
"Attempts - " & i, vbOKOnly, "MESSAGE FROM WorkBook.NewSheet"
End Sub
It works pretty good now. It is quite well as an interim solution.
But I still interested to find out an explanation what is wrong in the Excel to Macro communication.
So, if you will find one, please, share it with me.

How to Throw Error with Excel Prompt in VBA

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

VBA check if file exists

I have this code. It is supposed to check if a file exists and open it if it does. It does work if the file exists, and if it doesn't, however, whenever I leave the textbox blank and click the submit button, it fails. What I want, if the textbox is blank is to display the error message just like if the file didn't exist.
Runtime-error "1004"
Dim File As String
File = TextBox1.Value
Dim DirFile As String
DirFile = "C:\Documents and Settings\Administrator\Desktop\" & File
If Dir(DirFile) = "" Then
MsgBox "File does not exist"
Else
Workbooks.Open Filename:=DirFile
End If
something like this
best to use a workbook variable to provide further control (if needed) of the opened workbook
updated to test that file name was an actual workbook - which also makes the initial check redundant, other than to message the user than the Textbox is blank
Dim strFile As String
Dim WB As Workbook
strFile = Trim(TextBox1.Value)
Dim DirFile As String
If Len(strFile) = 0 Then Exit Sub
DirFile = "C:\Documents and Settings\Administrator\Desktop\" & strFile
If Len(Dir(DirFile)) = 0 Then
MsgBox "File does not exist"
Else
On Error Resume Next
Set WB = Workbooks.Open(DirFile)
On Error GoTo 0
If WB Is Nothing Then MsgBox DirFile & " is invalid", vbCritical
End If
I use this function to check for file existence:
Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
On Error Resume Next
IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function
For checking existence one can also use (works for both, files and folders):
Not Dir(DirFile, vbDirectory) = vbNullString
The result is True if a file or a directory exists.
Example:
If Not Dir("C:\Temp\test.xlsx", vbDirectory) = vbNullString Then
MsgBox "exists"
Else
MsgBox "does not exist"
End If
A way that is clean and short:
Public Function IsFile(s)
IsFile = CreateObject("Scripting.FileSystemObject").FileExists(s)
End Function
Function FileExists(ByRef strFileName As String) As Boolean
' TRUE if the argument is an existing file
' works with Unicode file names
On Error Resume Next
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
FileExists = objFSO.FileExists(strFileName)
On Error GoTo 0
End Function
To make the function run faster, objFSO can be made a global variable and the code can be modified and saved in a module like this:
Option Explicit
Dim objFSO As Object
Function FileExists(ByRef strFileName As String) As Boolean
' TRUE if the argument is an existing file
' works with Unicode file names
On Error Resume Next
If objFSO Is Nothing Then Set objFSO = CreateObject("Scripting.FileSystemObject")
FileExists = objFSO.FileExists(strFileName)
On Error GoTo 0
End Function
For strFileName to be a unicode string, you can, for example, either get it from a cell value or define it in a special way, as Excel's VBE doesn't save string constants in Unicode. VBE does support Unicode strings already saved in string variables. You're gonna have to look this up for further details.
Hope this helps somebody ^_^
Maybe it caused by Filename variable
File = TextBox1.Value
It should be
Filename = TextBox1.Value
Speed of Various FileExists Methods
I needed to check file existence for many of my projects, so I wanted to determine the fastest option. I used the micro timer code (see Benchmarking VBA Code) to run the File Exist functions below the table against a local folder with 2865 files to see which was faster. Winner used GetAttr. Using FSO method for Test 2 was a bit faster with the object defined as a global than not, but not as fast as the GetAttr method.
------------------------------------------------------
% of Fastest Seconds Name
------------------------------------------------------
100.00000000000% 0.0237387 Test 1 - GetAttr
7628.42784145720% 1.8108896 Test 2 - FSO (Obj Global)
8360.93687615602% 2.0522254 Test 2 - FSO (Obj in Function)
911.27399562739% 0.2163246 Test 3 - Dir
969.96844814586% 0.2302579 Test 4 - Dir$
969.75108156723% 0.2302063 Test 5 - VBA.Dir
933.82240813524% 0.2216773 Test 6 - VBA.Dir$
7810.66612746275% 1.8541506 Test 7 - Script.FSO
Function FileExistsGA(ByVal FileSpec As String) As Boolean
' Karl Peterson MS VB MVP
Dim Attr As Long
' Guard against bad FileSpec by ignoring errors
' retrieving its attributes.
On Error Resume Next
Attr = GetAttr(FileSpec)
If Err.Number = 0 Then
' No error, so something was found.
' If Directory attribute set, then not a file.
FileExistsGA = Not ((Attr And vbDirectory) = vbDirectory)
End If
End Function
Function FSOFileExists(sFilePathNameExt As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
FSOFileExists = fso.FileExists(sFilePathNameExt)
Set fso = Nothing
End Function
Function FileExistsDir(sFilePathNameExt As String) As Boolean
If Len(Dir(sFilePathNameExt)) > 0 Then FileExistsDir = True
End Function
Function FileExistsDirDollar(sFilePathNameExt As String) As Boolean
If Len(Dir$(sFilePathNameExt)) > 0 Then FileExistsDirDollar = True
End Function
Function FileExistsVBADirDollar(sFilePathNameExt As String) As Boolean
If Len(VBA.Dir$(sFilePathNameExt)) > 0 Then FileExistsVBADirDollar = True
End Function
Function FileExistsVBADir(sFilePathNameExt As String) As Boolean
If Len(VBA.Dir(sFilePathNameExt)) > 0 Then FileExistsVBADir = True
End Function
Public Function IsFileSFSO(s)
IsFileSFSO = CreateObject("Scripting.FileSystemObject").FileExists(s)
End Function
I realize that this does not fully answer the OP, but is provides information on which of the answers provided seems to be most efficient.
I'll throw this out there and then duck.
The usual reason to check if a file exists is to avoid an error when attempting to open it. How about using the error handler to deal with that:
Function openFileTest(filePathName As String, ByRef wkBook As Workbook, _
errorHandlingMethod As Long) As Boolean
'Returns True if filePathName is successfully opened,
' False otherwise.
Dim errorNum As Long
'***************************************************************************
' Open the file or determine that it doesn't exist.
On Error Resume Next:
Set wkBook = Workbooks.Open(fileName:=filePathName)
If Err.Number <> 0 Then
errorNum = Err.Number
'Error while attempting to open the file. Maybe it doesn't exist?
If Err.Number = 1004 Then
'***************************************************************************
'File doesn't exist.
'Better clear the error and point to the error handler before moving on.
Err.Clear
On Error GoTo OPENFILETEST_FAIL:
'[Clever code here to cope with non-existant file]
'...
'If the problem could not be resolved, invoke the error handler.
Err.Raise errorNum
Else
'No idea what the error is, but it's not due to a non-existant file
'Invoke the error handler.
Err.Clear
On Error GoTo OPENFILETEST_FAIL:
Err.Raise errorNum
End If
End If
'Either the file was successfully opened or the problem was resolved.
openFileTest = True
Exit Function
OPENFILETEST_FAIL:
errorNum = Err.Number
'Presumabley the problem is not a non-existant file, so it's
'some other error. Not sure what this would be, so...
If errorHandlingMethod < 2 Then
'The easy out is to clear the error, reset to the default error handler,
'and raise the error number again.
'This will immediately cause the code to terminate with VBA's standard
'run time error Message box:
errorNum = Err.Number
Err.Clear
On Error GoTo 0
Err.Raise errorNum
Exit Function
ElseIf errorHandlingMethod = 2 Then
'Easier debugging, generate a more informative message box, then terminate:
MsgBox "" _
& "Error while opening workbook." _
& "PathName: " & filePathName & vbCrLf _
& "Error " & errorNum & ": " & Err.Description & vbCrLf _
, vbExclamation _
, "Failure in function OpenFile(), IO Module"
End
Else
'The calling function is ok with a false result. That is the point
'of returning a boolean, after all.
openFileTest = False
Exit Function
End If
End Function 'openFileTest()
Here is my updated code. Checks to see if version exists before saving and saves as the next available version number.
Sub SaveNewVersion()
Dim fileName As String, index As Long, ext As String
arr = Split(ActiveWorkbook.Name, ".")
ext = arr(UBound(arr))
fileName = ActiveWorkbook.FullName
If InStr(ActiveWorkbook.Name, "_v") = 0 Then
fileName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) & "_v1." & ext
End If
Do Until Len(Dir(fileName)) = 0
index = CInt(Split(Right(fileName, Len(fileName) - InStr(fileName, "_v") - 1), ".")(0))
index = index + 1
fileName = Left(fileName, InStr(fileName, "_v") - 1) & "_v" & index & "." & ext
'Debug.Print fileName
Loop
ActiveWorkbook.SaveAs (fileName)
End Sub
You should set a condition loop to check the TextBox1 value.
If TextBox1.value = "" then
MsgBox "The file not exist"
Exit sub 'exit the macro
End If
Hope it help you.

Resources