I have a function that checks whether or not a worksheet named wsName
exists already in the workbook. The issue I am having is getting the function to run with the restructuring and removal of On Error Resume Next
. What I am expecting is the macro to run and produce copies of the worksheets that do not already exist in the workbook and if the worksheets do already exist, then print out ErrorMsg
saying "Unknown Error"
. What I see however, is the macro print out the ErrorMsg
even if the worksheet does not exist and makes a copy of it. I am trying this approach to SheetExists
to see if there is a way to get the function to run without using On Error Resume Next
as I do not want to macro to ignore errors that are generated, rather I would want it to print out "Unknown Error"
Global Parameter As Long, RoutingStep As Long, wsName As String, version As String, ErrorMsg As String, SDtab As Worksheet
Global wb As Workbook, sysrow As Long, sysnum As String, ws As Worksheet
Public Sub Main()
Dim syswaiver As Long, axsunpart As Long
Dim startcell As String, cell As Range
Dim syscol As Long, dict As Object, wbSrc As Workbook
Set wb = Workbooks("SD3_KW.xlsm")
Set ws = wb.Worksheets("Data Sheet")
syswaiver = 3
axsunpart = 4
Set wbSrc = Workbooks.Open("Q:\Documents\Specification Document.xlsx")
Set dict = CreateObject("scripting.dictionary")
If Not syswaiver = 0 Then
startcell = ws.cells(2, syswaiver).Address
Else
ErrorMsg = "waiver number column index not found. Value needed to proceed"
GoTo Skip
End If
For Each cell In ws.Range(startcell, ws.cells(ws.Rows.Count, syswaiver).End(xlUp)).cells
sysnum = cell.value
sysrow = cell.row
syscol = cell.column
If Not dict.Exists(sysnum) Then
dict.Add sysnum, True
If Not SheetExists(sysnum, wb) Then
If Not axsunpart = 0 Then
wsName = cell.EntireRow.Columns(axsunpart).value
If SheetExists(wsName, wbSrc) Then
wbSrc.Worksheets(wsName).copy After:=ws
wb.Worksheets(wsName).Name = sysnum
Set SDtab = wb.Worksheets(ws.Index 1)
Else
ErrorMsg = ErrorMsg & IIf(ErrorMsg = "", "", "") & "part number for " & sysnum & " sheet to be copied could not be found"
cell.Interior.Color = vbRed
GoTo Skip
End If
Else
ErrorMsg = "part number column index not found. Value needed to proceed"
End If
Else
MsgBox "Sheet " & sysnum & " already exists."
End If
End If
Skip:
Dim begincell As Long, logsht As Worksheet
Set logsht = wb.Worksheets("Log Sheet")
With logsht ' wb.Worksheets("Log Sheet")
begincell = .cells(Rows.Count, 1).End(xlUp).row
.cells(begincell 1, 3).value = sysnum
.cells(begincell 1, 3).Font.Bold = True
.cells(begincell 1, 2).value = Date
.cells(begincell 1, 2).Font.Bold = True
If Not ErrorMsg = "" Then
.cells(begincell 1, 4).value = vbNewLine & "Complete with Erorr - " & vbNewLine & ErrorMsg
.cells(begincell 1, 4).Font.Bold = True
.cells(begincell 1, 4).Interior.Color = vbRed
Else
.cells(begincell 1, 4).value = "All Sections Completed without Errors"
.cells(begincell 1, 4).Font.Bold = True
.cells(begincell 1, 4).Interior.Color = vbGreen
End If
End With
Next Cell
End Sub
Function SheetExists(SheetName As String, wb As Workbook)
On Error GoTo Message
SheetExists = Not wb.Sheets(SheetName) Is Nothing
Exit Function
Message:
ErrorMsg = "Unknown Error"
End Function
CodePudding user response:
Your function code reaches always the last line, in the way it is...
You must place a code line to exit function if the sheet object exists:
Function SheetExists_(SheetName As String, wb As Workbook) As Boolean
On Error GoTo Message
SheetExists_ = Not wb.Sheets(SheetName) Is Nothing
If Not wb.Sheets(SheetName) Is Nothing Then Exit Function
Message:
MsgBox "Unknown Error"
End Function
Edited:
Function SheetExists_(SheetName As String, wb As Workbook) As Boolean
On Error GoTo Message
SheetExists_ = Not wb.Sheets(SheetName) Is Nothing: Exit Function
Message:
'reaching this part will (only) make it returning `False`...
End Function
Please, take care that the above function is SheetExists_
. It has an underscore character of the name end. I have another function with this name...
CodePudding user response:
Your "SheetExists" function will always set "ErrorMsg" to "Unknown Error". Add "Exit Function" after
SheetExists = Not wb.Sheets(SheetName) Is Nothing
CodePudding user response:
The way you have it now, you set ErrorMsg to "Unknown Error" when the sheet doesn't exist. That's why you'll get the error with every sheet since every sheet is different in your test-setup. Your function will still give a False (doesn't exist) but also the error.
CodePudding user response:
Use a simple function to check. And you shall not confuse sheet with worksheet
Public Function sh_Exist(TheWorkbook As Workbook, SheetName As String) As Boolean
Dim s As String
On Error GoTo errHandler
s = TheWorkbook.Sheets(SheetName).Name
sh_Exist = True
Exit Function
errHandler:
End Function