Argthtjtr

I have a sub which opens an older version of a checklist I've created, and then imports the data. After the user selects the file, I want to check if a specific sheet and named cell on that sheet exists (for validation they have picked the correct file - the sheet will always be "Main Page" and the cell "Version"). If either doesn't exist, then I want a message box and to exit sub. If they both exist, then continue with the rest of the import.

Most of it works, it's just the first check for the named sheet/cell. The main problem is this bit of the sub:

If Not WorksheetExists("Main Page") Then

    MsgBox "The selected file does not appear to be an older version of the checklist." & vbNewLine & vbNewLine & "Please check that you have selected the correct file."

    wbCopyFrom.Close SaveChanges:=False

    Exit Sub

End If

And the called function:

Function WorksheetExists(sName As String) As Boolean



WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")



End Function

This function at the moment checks the sheet name fine. But I'm getting a little confused on how to check the cell name - do I need another function or can I just edit the above function to check for both at the same time? ie. I think I can change the line:

WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")

to include the cell name instead of the A1 bit.

The whole sub and other functions are below for context if that helps.

Sub ImportLists()



If MsgBox("The import process will take some time (approximately 10 minutes); please be patient while it is running. It is recommended you close any other memory-intensive programs before continuing. Click 'Cancel' to run at another time.", vbOKCancel) = vbCancel Then Exit Sub



Application.ScreenUpdating = False



Dim OldFile As Variant, wbCopyFrom As Workbook, wsCopyFrom As Worksheet, wbCopyTo As Workbook, wsCopyTo As Worksheet, OutRng As Range, c As Range, RangeName As Range



Set wbCopyTo = ActiveWorkbook

ChDir ThisWorkbook.Path

OldFile = Application.GetOpenFilename("All Excel Files (*.xls*)," & "*.xls*", 1, "Select a previous version of the checklist", "Import", False)



If TypeName(OldFile) = "Boolean" Then

    MsgBox "An error occured while importing the old version." & vbNewLine & vbNewLine & "Please check you have selected the correct checklist file and filetype (.xlsm)."

Exit Sub

End If



Set wbCopyFrom = Workbooks.Open(OldFile)



If Not WorksheetExists("Main Page") Then

    MsgBox "The selected file does not appear to be an older version of the checklist." & vbNewLine & vbNewLine & "Please check that you have selected the correct file."

    wbCopyFrom.Close SaveChanges:=False

    Exit Sub

End If



OldVersion = Right(wbCopyFrom.Sheets("Main Page").Range("Version").Value, Len(wbCopyFrom.Sheets("Main Page").Range("Version").Value) - 1)

NewVersion = Right(wbCopyTo.Sheets("Main Page").Range("Version").Value, Len(wbCopyTo.Sheets("Main Page").Range("Version").Value) - 1)



If NewVersion < OldVersion Then

    MsgBox "The selected older version of the checklist (v" & OldVersion & ") appears to be newer than the current version (v" & NewVersion & ")." & vbNewLine & vbNewLine & "Please check that you have selected the correct older version of the checklist or that the current checklist is not an older version."

    wbCopyFrom.Close SaveChanges:=False

    Exit Sub

End If



For Each wsCopyFrom In wbCopyFrom.Worksheets

    If wsCopyFrom.Name <> "Set List" And wsCopyFrom.Name <> "Rarity Type Species List" And wsCopyFrom.Name <> "Need List" And wsCopyFrom.Name <> "Swap List" And wsCopyFrom.Name <> "Reference List" Then

        Set wsCopyTo = wbCopyTo.Worksheets(wsCopyFrom.Name)

        Set OutRng = UsedRangeUnlocked(wsCopyFrom)

        If Not OutRng Is Nothing Then

            For Each c In OutRng

                If wsCopyTo.Range(c.Address).Locked = False Then

                    c.Copy wsCopyTo.Range(c.Address)

                End If

            Next c

        End If

    End If

Next wsCopyFrom



wbCopyFrom.Close SaveChanges:=False

Call CalcRefilter



Application.ScreenUpdating = True



MsgBox "The checklist was successfully imported from version " & OldVersion & " and updated to version " & NewVersion & "." & vbNewLine & vbNewLine & "Don't forget to save the new version."



End Sub



Function WorksheetExists(sName As String) As Boolean



WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")



End Function



Function UsedRangeUnlocked(ws As Worksheet) As Range



Dim RngUL As Range, c As Range



For Each c In ws.UsedRange.Cells

    If Not c.Locked Then

        If RngUL Is Nothing Then

            Set RngUL = c

        Else

            Set RngUL = Application.Union(RngUL, c)

        End If

    End If

Next c

Set UsedRangeUnlocked = RngUL



End Function

You can try to access the range. If it throws an error it does not exist:

Function RangeExists(RangeName As String) As Boolean

    Dim rng As Range

    On Error Resume Next

    Set rng = Range(RangeName)

    On Error GoTo 0 'needed to clear the error. Alternative Err.Clear

    RangeExists = Not rng Is Nothing

End Function

Or to check at once if both exists (worksheet and range):

Function SheetAndRangeExists(WorksheetName As String, RangeName As String) As Boolean

    Dim rng As Range

    On Error Resume Next

    Set rng = Worksheets(WorksheetName).Range(RangeName)

    On Error GoTo 0

    SheetAndRangeExists = Not rng Is Nothing

End Function

If you want to test it in a specific workbook:

Function SheetAndRangeExists(InWorkbook As Workbook, WorksheetName As String, RangeName As String) As Boolean

    Dim rng As Range

    On Error Resume Next

    Set rng = InWorkbook.Worksheets(WorksheetName).Range(RangeName)

    On Error GoTo 0

    SheetAndRangeExists = Not rng Is Nothing

End Function

and call like SheetAndRangeExists(ThisWorkbook, "Main Page", "Version")