Return full name from delimited string given partial name

[sparky2205]

Hi folks,
I have a macro that allows users to delete certain worksheets from protected workbooks.
The user is not allowed delete any worksheet that exists in the template.
However, there is a macro to allow the user to add a new sheet and rename it whatever they want.
They are allowed to delete these newly created worksheets.
I wanted to make this macro generic so it could be easily transferred between workbooks.
So the setup is as follows:
Create a worksheet called "WS_Names" in the workbook and list all the existing (can't be deleted) worksheet names in cell A1 as follows;
front sheet|page tracker|equipment|assembly - npi (optional)|assembly - production 100%|assembly - production sample|boy1 or boy2 setup|final inspection|sterilization & release|ws_names|
Then the code:

Sub Delete_Worksheet()
Dim sWSName As String
Dim icount As Integer
Dim sWSNames As String
Dim ws As Worksheet
Dim icountname As Integer
Dim ans As String
Dim pw As String
Dim sfind As String

    pw = "Test"

'   Prevent screen flicker when executing
    Application.ScreenUpdating = False

    icountname = 0
    
'   Get the list of Worksheet names that are not allowed to be deleted
    sWSNames = Worksheets("WS_Names").Cells(1, "A").Value
'   Ask the user for the name of the Worksheet to be deleted
    sWSName = Application.InputBox("Enter the Worksheet name to delete", Type:=2)
    sfind = InStr(sWSNames, LCase$(sWSName))
'   Check if the user presses Cancel or doesn't make an entry in the inputbox.  Exit if either is true.
    If sWSName = "False" Or sWSName = "" Then
        Exit Sub
    End If
'   Check if the entered Worksheet name exists in the spreadsheet
    For Each ws In ThisWorkbook.Worksheets
        If UCase(ws.Name) = UCase(sWSName) Then
            icountname = icountname + 1
        End If
    Next ws
    If icountname = 0 Then
        MsgBox "Worksheet name " & Chr(34) & sWSName & Chr(34) & " does not exist in this file"
        Exit Sub
    End If
'   Ensure that the Worksheet name entered is not on the list of worksheets not be be deleted
    If InStr(sWSNames, LCase$(sWSName)) = 0 Then
'       If it is confirm with the user that they want to delete that worksheet
        ans = MsgBox("You are deleting Worksheet " & Chr(34) & Application.WorksheetFunction.Proper(sWSName) & Chr(34) & ". Do you wish to proceed?", vbOKCancel)
'       If the user changes their mind then cancel
        If ans = vbCancel Then
            Exit Sub
        End If
'       Otherwise delete the Worksheet
        Sheets(sWSName).Select
        ' Prevent display of Excels basic alert message. See customised message above.
        Application.DisplayAlerts = False
        ' Unprotect the Workbook to delete the Worksheet
        ThisWorkbook.Unprotect Password:=pw
        ActiveWindow.SelectedSheets.Delete
        ' Protect the Workbook again after the Worksheet is deleted
        ThisWorkbook.Protect Password:=pw, structure:=True
        ' Reenable display of alert messages
        Application.DisplayAlerts = True
'   Check that the Worksheet name entered is on the list of worksheets not be be deleted...
    ElseIf InStr(sWSNames, LCase$(sWSName)) <> 0 Then
'       ...but only partially (e.g. not allowed to delete "Page Tracker" but allowed to delete newly added worksheet "Page".
        If Mid(sWSNames, sfind, InStr(sfind, sWSNames, "|") - sfind) <> LCase(sWSName) Then
'       If it is confirm with the user that they want to delete that worksheet
        ans = MsgBox("You are deleting Worksheet " & Chr(34) & Application.WorksheetFunction.Proper(sWSName) & Chr(34) & ". Do you wish to proceed?", vbOKCancel)
'       If the user changes their mind then cancel
        If ans = vbCancel Then
            Exit Sub
        End If
'       Otherwise delete the Worksheet
        Sheets(sWSName).Select
        ' Prevent display of Excels basic alert message. See customised message above.
        Application.DisplayAlerts = False
        ' Unprotect the Workbook to delete the Worksheet
        ThisWorkbook.Unprotect Password:=pw
        ActiveWindow.SelectedSheets.Delete
        ' Protect the Workbook again after the Worksheet is deleted
        ThisWorkbook.Protect Password:=pw, structure:=True
        ' Reenable display of alert messages
        Application.DisplayAlerts = True
    Else:
          MsgBox ("Deleting Worksheet " & Chr(34) & Application.WorksheetFunction.Proper(sWSName) & Chr(34) & " is not allowed")
    End If
    End If

'   Reenable ScreenUpdating
    Application.ScreenUpdating = True
End Sub

Everything works fine for:
• Deleting an existing worksheet (not allowed)
• Deleting a newly created worksheet that doesn't contain any part of the name of an existing worksheet
• Deleting a newly created worksheet that has the first part of an existing worksheet name as its name e.g. existing worksheet = page tracker; new worksheet = page
The problem:
• Deleting a newly created worksheet that has the last part of an existing worksheet name as its name e.g. existing worksheet = page tracker; new worksheet = tracker

In my code I get the starting position of the worksheet name to be deleted in the string and return the existing worksheet name from that point.
But if the worksheet to be deleted is called tracker and the existing worksheet name is page tracker then tracker will be returned in both cases and my test fails.
What I'm really looking for here is a way to return the complete name from the string given a part of the name, in particular the last part of the name.
Please let me know if you require any clarifications or further information.
Thanks folks.

 

[John_w]

Maybe this idea will work.

Change:

sWSNames = Worksheets("WS_Names").Cells(1, "A").Value

to:

sWSNames = "|" & Worksheets("WS_Names").Cells(1, "A").Value

and prepend "|" to the start of the worksheet name you're searching for to see if the existing worksheet starts with that name:

If InStr(sWSNames, "|" & LCase$(sWSName)) > 0 Then  'found at start

and append "|" to the end of the worksheet name you're searching for to see if the existing worksheet ends with that name:

If InStr(sWSNames, LCase$(sWSName) & "|") > 0 Then  'found at end

 

[sparky2205]

Hi John,
thanks for that. I can make it a bit easier in that I can have the starting "|" already on my string, like so:
|front sheet|page tracker|line clearance|dimensional specifications|visual specifications|equipment|assembly - npi (optional)|assembly - production 100%|assembly - production sample|boy1 or boy2 setup|boy3 or boy4 or boy5 setup|moulding|final inspection|packaging|functional testing|labels|sterilization & release|ws_names|


However, appending the "|" at the end of the sheet name to be deleted won't work as I still need to compare it to something.
I can't just say: If InStr(sWSNames, LCase$(sWSName) & "|") <> 0 then delete the worksheet as in the case of worksheet "Tracker" this would also allow the deletion of worksheet "Page Tracker".
Unless I am missing something in the intent of your solution.


What I really need is some way to isolate the full sheet name in the string given a partial name e.g. Isolate "Page Tracker" given "Tracker".
If I had that I could then compare these values and allow deletion when they don't match.
Hard to believe there isn't some way to achieve this.

 

[sparky2205]

Hi John,
I found a way to achieve this so I thought I'd post it here in case it might be of use to others.
I found this little gem, InStrRev. It does exactly what it says on the tin. It's a reverse InStr. Just be careful when using, as the arguments, for some unknown reason, are not in the same order as InStr. I can't believe I only just found this. It makes extracting a substring from a string so much easier.
I'm posting my finished code below:

Sub Delete_Worksheet()
Dim sWSName As String
Dim sWSNames As String
Dim iCountName As Integer
Dim ans As String
Dim sfind1 As Integer
Dim sfind2 As Integer
Dim sfind3 As Integer
Dim ssubstring As String
Dim pw As String
    pw = "Test"
    sWSNames = Worksheets("WS_Names").Cells(1, "A").Value
    sWSName = Application.InputBox("Enter the Worksheet name to delete", Type:=2)
    
'   Check if the user presses Cancel or doesn't make an entry in the inputbox.  Exit if either is true.
    If sWSName = "False" Or sWSName = "" Then
        Exit Sub
    End If
    
'   Check if the entered Worksheet name exists in the spreadsheet
    For Each ws In ThisWorkbook.Worksheets
        If UCase(ws.Name) = UCase(sWSName) Then
            iCountName = iCountName + 1
        End If
    Next ws
    If iCountName = 0 Then
        MsgBox "Worksheet name " & Chr(34) & sWSName & Chr(34) & " does not exist in this file"
        Exit Sub
    End If
    
'   Check if the Worksheet name entered is on the list of worksheets not be be deleted
    sfind1 = InStr(sWSNames, LCase$(sWSName))
'   If the Worksheet name entered is not on the list of worksheets not be be deleted
    If sfind1 = 0 Then
'       Confirm with the user that they want to delete that Worksheet
        ans = MsgBox("You are deleting Worksheet " & Chr(34) & Application.WorksheetFunction.Proper(sWSName) & Chr(34) & ". Do you wish to proceed?", vbOKCancel)
'       If the user changes their mind and cancels
        If ans = vbCancel Then
            Exit Sub
        End If
'       Otherwise delete the Worksheet
        Sheets(sWSName).Select
'       Prevent display of Excels basic alert message. See customised message above.
        Application.DisplayAlerts = False
'       Unprotect the Workbook to delete the Worksheet
        ThisWorkbook.Unprotect Password:=pw
        ActiveWindow.SelectedSheets.Delete
'       Protect the Workbook again after the Worksheet is deleted
        ThisWorkbook.Protect Password:=pw, structure:=True
'       Reenable display of alert messages
        Application.DisplayAlerts = True
    Else
'       Extract the Worksheet name from the string in WS_Names A1
'       Find the position of the "|" at the end of the Worksheet name using sfind1
        sfind2 = InStr(sfind1, sWSNames, "|")
'       Find the position of the "|" at the beginning of the Worksheet name using sfind2
        sfind3 = InStrRev(sWSNames, "|", sfind2 - 1)
'       Extract the Worksheet name using sfind1, sfind2 & sfind3
'       Note: where sWSName = sWSNames, rather than being a substring, sfind1 = sfind3
        ssubstring = Mid(sWSNames, sfind3 + 1, (sfind2 - sfind3) - 1)
'       If sWSName is a substring of sWSNames then allow it to be deleted
        If ssubstring <> LCase$(sWSName) Then
            ans = MsgBox("You are deleting Worksheet " & Chr(34) & Application.WorksheetFunction.Proper(sWSName) & Chr(34) & ". Do you wish to proceed?", vbOKCancel)
            If ans = vbCancel Then
                Exit Sub
            End If
            Sheets(sWSName).Select
            Application.DisplayAlerts = False
            ThisWorkbook.Unprotect Password:=pw
            ActiveWindow.SelectedSheets.Delete
            ThisWorkbook.Protect Password:=pw, structure:=True
            Application.DisplayAlerts = True
        Else
'           Prevent deletion of the Worksheet
            MsgBox ("Deleting Worksheet " & Chr(34) & Application.WorksheetFunction.Proper(sWSName) & Chr(34) & " is not allowed")
        End If
    End If
End Sub

In order to make the macro generic i.e. usable across different spreadsheets I do the following:
• Add a worksheet to the workbook called WS_Names. This needs to be done for any workbook where the macro will be used.
• In cell A1 of this worksheet list all the worksheets that it is forbidden to delete ensuring to include WS_Names.
• Hide worksheet WS_Names