Home > database >  Function Check if Worksheet Exists
Function Check if Worksheet Exists

Time:11-16

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
  • Related