This is my code:
Private Sub New_User_Create_Click()
CreateUsername_L = LCase(Create_User_Text.Text)
For Each ws In Worksheets
If (Worksheets(CreateUsername_L).Name <> "") Then
MsgBox "Username is already taken! Try again!"
Create_User_Text.Text = ""
NewUser.Hide
Exit For
Else
Dim work As Worksheet
With ThisWorkbook
Set worksheetname = .Sheets.Add(After:=Worksheets(Worksheets.Count))
worksheetname.Name = CreateUsername_L
On Error Resume Next
Create_User_Text.Text = ""
NewUser.Hide
[B1].Value = (UserName + "'s Personal Profile")
Exit For
End With
End If
Next ws
End Sub
If you could help me with this it would be much appreciated
(also the error only occurs when the condition is not met e.g there is no sheet with the same name as "CreateUsername_L". When the condition is met the message box with "Username is already taken..." shows up so its only when the condition is not met when this error occurs)
You can't test for the existance of the worksheet name like you're trying to do. The 'Subscript out of range' error is looking for that worksheet name and if it can't find it then you get your error. You can write a function to test for the existence of a name and use that instead. Here's mine:
Public Function doesSheetNameExist(inputName As String) As Boolean
Dim ws As Worksheet
On Error GoTo ErrorCatch
Set ws = Thisworkbook.Worksheets(inputName)
'if no error here then worksheet exists
doesSheetNameExist= True
CloseFunction:
Exit Function
ErrorCatch:
doesSheetNameExist= False
Resume CloseFunction
End Function
This handles the error within the function. Alternatively you could loop through each worksheet and test the name.
You'd then replace your line
If (Worksheets(CreateUsername_L).Name <> "") Then
with
If doesSheetNameExist(CreateUsername_L) Then
Related
I am currently running a VBA script in excel to allow for specific username and password access to specific sheets. I was following this tutorial on youtube and everything seemed to be going well until I began encountering errors.
I am getting a Type mismatch error in my code, which is below. There are two lines that are giving me errors, they are commented, any help would be greatly appreciated!
Option Explicit
Sub CheckUser()
Dim UserRow, SheetCol As Long
Dim SheetNm As String
With Sheet34
.Calculate
If .Range("B6").Value = Empty Then 'Incorrect Username
MsgBox "Please enter a correct username"
Exit Sub
End If
If .Range("B5").Value <> True Then 'Incorrect Password
MsgBox "Please enter a correct password"
Exit Sub
End If
UserForm1.Hide
UserRow = .Range("b6").Value 'userrow
.Range("B3").Value = ""
.Range("b4").Value = ""
For SheetCol = 6 To 26
SheetNm = .Cells(2, SheetCol).Value 'SheetName
If .Cells(UserRow, SheetCol).Value = "Ð" Then ' line where error occurs
Sheets(SheetNm).Protect "TEP2003"
Sheets(SheetNm).Visible = xlSheetVisible
End If
If .Cells(UserRow, SheetCol).Value = "Ï" Then ' line where error occurs
Sheets(SheetNm).Visible = xlVeryHidden
End If
Next SheetCol
End With
End Sub
Sub closeworkbook()
Sheet1.Activate
Dim WkSht As Worksheet
For Each WkSht In ThisWorkbook.Worksheets
If WkSht.Name <> "Main" Then WkSht.Visible = xlSheetVeryHidden
Next WkSht
ThisWorkbook.Save
End Sub
Use the Range.Text property. Range.Text will not fix a worksheet error code but it will evaluate one as text where Range.Value will fail. Combine the two with an ElseIf; there is no point in evaluating the second if the first passes.
...
If .Cells(UserRow, SheetCol).Text = "Ð" Then
...
ElseIf .Cells(UserRow, SheetCol).Text = "I" Then
...
End If
I am trying to assign an opened workbook to an workbook object. If that workbook is not already opened, then it throws an error. I am handling the errors using an Error Handler.
This works for me:
On Error GoTo OpenWorkbookError
Set Uwk = Application.Workbooks(WbkName)
OpenWorkbookError:
If Err <> 0 Then
Err.Clear
MsgBox ("Please Open the Required Workbook")
Exit Sub
End If
But is there a way to avoid using the error handlers in this situation.
One way to do it is check each workbook name, but what's wrong with the functions in the link that #SJR gave?
In your provided code you've kept the error handler within the main body of code - it should appear between the Exit Sub and End Sub at the end of the procedure.
Something like this would work without an error handler, but it's slower as it needs to check each workbook:
Sub Test()
Dim Uwk As Workbook
Dim WbkName As String
WbkName = "PERSONAL.XLSB"
For Each Uwk In Workbooks
If Uwk.Name = WbkName Then
Exit For
End If
Next Uwk
If Not Uwk Is Nothing Then
MsgBox Uwk.Name & " found!"
Else
MsgBox "Not found."
End If
End Sub
Your version of the code should have the error handler outside the main body:
Sub Test1()
Dim WbkName As String
Dim UWk As Workbook
WbkName = "PERSONAL1.XLSB"
On Error GoTo OpenWorkbookError
Set UWk = Workbooks(WbkName)
TidyExit:
'Close anything that needs closing and Exit.
Exit Sub '<< End of main body of procedure.
OpenWorkbookError:
Select Case Err.Number
Case 9 'Subscript out of range.
MsgBox "Please open the required workbook."
Resume TidyExit
Case Else
MsgBox "Error " & Err.Number & vbCr & _
Err.Description, vbOKOnly + vbCritical
Resume TidyExit
End Select
End Sub '<< End of procedure.
I have the following code that works fine until the end of the MsgBox:
Sub CommentsAsFootnotes(myTemplate As Variant, ByRef footnotespage1 As String, ByRef footnotespage2 As String)
Dim rngTemp As Range
Dim rngComment As Range
Dim footnote As String
Dim i As Integer
On Error Resume Next
Set rngComment = myTemplate.Sheets("Seite 1 ").Range("B14:T35").SpecialCells(xlCellTypeComments)
On Error GoTo 0
i = 1
'If rngComment is Nothing
'Exit Sub
'End If
For Each rngTemp In rngComment
rngTemp.value = rngTemp.value & CStr(i)
rngTemp.Characters(Start:=Len(rngTemp.value), Length:=1).Font.Superscript = True
MsgBox rngTemp.Comment.Text
' error thrown here
Next rngTemp
footnotespage1 = footnote
End Sub
The message box is shown with the correct content.
However, when I click "OK", an error is thrown "Error 91, Object variable or with block variable not set" and the debugger highlights the line with the message box.
Do you have any idea what could cause this error?
It's because that current range doesn't have a comment inside, add an IF when the cell doesn't have any comment inside, like this :
If rngTemp.Comment Is Nothing Then
MsgBox "No Comment found !"
Else
MsgBox rngTemp.Comment.Text
End If
I have several tables in an excel sheet. Each having unique table Name. I want to know if a table which has a name "Table123" exist or not in the current sheet.
Could some one help me on this?
Thanks
Jeevan
TableExists = False
On Error GoTo Skip
If ActiveSheet.ListObjects("Table123").Name = "Table123" Then TableExists = True
Skip:
On Error GoTo 0
This code will work and avoid loops and errors
Here is an alternative function:
Function TableExistsOnSheet(ws As Worksheet, sTableName As String) As Boolean
TableExistsOnSheet = ws.Evaluate("ISREF(" & sTableName & ")")
End Function
You can list shape collection and compare names like this
Sub callTableExists()
MsgBox tableExists("Table1", "Shapes")
End Sub
Function TableExists(tableName As String, sheetName As String) As Boolean
Dim targetSheet As Worksheet
Set targetSheet = Worksheets(sheetName)
Dim tbl As ListObject
With targetSheet
For Each tbl In .ListObjects
If tbl.Name = tableName Then TableExists = True
Next tbl
End With
End Function
Another option, using a bit lazy approach with error catching:
Public Sub TestMe()
If TableExists("Table1243", ActiveSheet) Then
MsgBox "Table Exists"
Else
MsgBox "Nope!"
End If
End Sub
Public Function TableExists(tableName As String, ws As Worksheet) As Boolean
On Error GoTo TableExists_Error
If ws.ListObjects(tableName).Name = vbNullString Then
End If
TableExists = True
On Error GoTo 0
Exit Function
TableExists_Error:
TableExists = False
End Function
Try this, use err to get data table status information
also, consider testing the data table on an inactive sheet.
Sub Test_TableNameExists()
TableNm = "Table00"
MsgOutput = TableNm & vbTab & TableNameExists(TableNm)
End Sub
Private Function TableNameExists(nname) As Boolean '#Table #Exist
'Returns TRUE if the data table name exists
'Can test table on inactive sheet
Dim x As Object
On Error Resume Next
'use Range(nname).Parent to get data table sheet name.
'So the function can test data table on inactive sheet.
Set x = Range(nname).Parent.ListObjects(nname)
If Err = 0 Then TableNameExists = True _
Else TableNameExists = False
End Function
Without the use of GoTo, which is a lot more powerfull than appropriate.
Set TableExists = False
On Error Resume Next
If ActiveSheet.ListObjects("Table123").Name = "Table123" Then Set TableExists = True
Be aware that this applies to a single line, thus requiring the line continuation symbol _ to keep larger statements readable.
This question already has answers here:
Why VBA goes to error handling code when there is no error?
(5 answers)
Closed last year.
I have my code below, the strange thing is that the Errorhandler procedure is still executing even though there are no errors in the code... What can be the issue?
Running the code without any errorhandlers generates no errors, but still the msgbox under Errorhandler shows up when I include an error handling statement!
Code
Public Sub ExportGraphs(Optional PivotExport As Boolean)
' Exports only graphs on the "Mainwindow" sheet to a new worksheet
Dim wsh As Worksheet: Set wsh = Sheets.Add
Dim source_sht As Worksheet: Set source_sht = Sheets("Mainwindow")
ActiveWindow.Zoom = 70
On Error GoTo Errorhandler
With wsh
If source_sht.OLEObjects("Btn_CurrentTime").Object.Value = True Then
.Name = source_sht.OLEObjects("CombBox_Instruments").Object.Value & " " & source_sht.OLEObjects("DTPicker_FROM").Object.Value _
& "-" & source_sht.OLEObjects("DTPicker_TO").Object.Value
Else
.Name = source_sht.OLEObjects("CombBox_Instruments").Object.Value & " " & "Max_Possible_To" _
& "-" & source_sht.OLEObjects("DTPicker_TO").Object.Value
End If
End With
Dim source_chart As ChartObject
Dim target_rng As Range: Set target_rng = wsh.Range("A1")
For Each source_chart In source_sht.ChartObjects
source_chart.CopyPicture xlScreen, xlBitmap
target_rng.PasteSpecial
Set target_rng = target_rng.Offset(20, 0)
Next
If PivotExport = True Then
Debug.Print "se"
End If
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
#dee provided the correct answer.
The Errorhandler: is just a place holder. It does NOT operate like you think. You are using it like an If... Then... statement:
If Error Then
Show MsgBox
Else
Skip MsgBox
End If
As the Errorhandler is just a placeholder and NOT an If... Then..., the code after the placeholder will run regardless of error or no error. To rectify this issue, add an Exit Sub above the Errorhandler: line:
Exit Sub
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
In this piece of code, ErrorHandler: is what is known as a line label.
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
Line labels are not executable code, but rather just a marker that can tell other code where to jump to via any GoTo Statement. Armed with this knowledge, they are obviously not exclusive to error handlers.
The solution here is to use the Exit Statement to return from the Sub "early".
Exit Sub
Errorhandler:
MsgBox "An export sheet for this ticker and timeline already exists"
End Sub
Others may disagree with me, but I like to build my error handling so that the code always stops execution on Exit Sub. If the code ends its execution on End Sub, something has gone wrong.