Rename sheet that sheet exsits

[TLA]

I can't get this to work. I have the following code on my sheet which executes when cells are changed. If the user enters values in B3 or D3 the sheet renames itself to the value that is in that cell.

I ran into an issue if a sheet by that name already exists. so I added the code in bold I found elsewhere on this site. However it keeps exectuing the code in italics when there is a duplicate sheet already in the workbook and I can't see why.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim wsSheet As Worksheet
' Only look at single cell changes
If Target.Count > 1 Then Exit Sub
'add date when user is selected
If Target.Column = 2 And Target.Row = 2 Then
If Target <> "" And Target.Offset(, 2).Value = "" Then
Target.Offset(, 2) = Date
Else
Target.Offset(, 2) = ""
End If
End If
'delete location when pallet entered
If Target.Column = 2 And Target.Row = 3 Then
If Target <> "" Then
Target.Offset(, 2) = ""
On Error Resume Next
Set wsSheet = Sheets(Cells(3, 2).Value)
On Error GoTo 0
'determining if the worksheet name already exists
If Not wsSheet Is Nothing Then
ActiveSheet.Name = InputBox("Sheet", "Enter Sheet Name", Cells(3, 2).Value)
Else
ActiveSheet.Name = "Pallet " & Cells(3, 2).Value
Exit Sub
End If
End If
End If

Basically I want the sheet name to change to what the type in Cell B3. If a sheet with that name exists I want it to pop an input box with the Sheet name in it so they can add a -1, -2, --3 to it and hit ok and get that sheet name.

 

[Tom Urtis]

Your primary problem (what you noticed) was due to you changing cell D3 with a date when cell B3 changed, and that retriggered the sheet change event and caused VBA to think you were relying on the cell 2 columns to the right as the change value.

However, there are many other minefields you did not consider, such as length of sheet name (if more than 31 characters are entered into B3 or D3), or if illegal sheet-naming characters are attempted to be entered.

This will get you closer. The "-1", "-2", "-3" bit is something I would avoid having the user enter because they'll only get it wrong, and just have VBA do it automatically, or have the user re-enter a new name, as the following code exhibits.

Replace the SheetChange code you currently have with this this:

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address <> "$B$3" And .Address <> "$D$3" Then Exit Sub
If .Cells.Count > 1 Then Exit Sub

Application.EnableEvents = False
If IsEmpty(Target) Then
.Offset(0, 2).ClearContents
Else
.Offset(0, 2).Value = VBA.Date
End If
Application.EnableEvents = True

Dim mySheetName$
mySheetName = .Value
End With

'If the length of the entry is greater than 31 characters, disallow the entry.
If Len(mySheetName) > 31 Then
MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
"You entered " & mySheetName & ", which has " & Len(mySheetName) & " characters.", , _
"Keep it under 31 characters"
Exit Sub
End If

'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
'Verify that none of these characters are present in the cell's entry.
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"

For i = 1 To 7
If InStr(mySheetName, (IllegalCharacter(i))) > 0 Then
MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
"Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, _
"Not a possible sheet name !!"
Exit Sub
End If
Next i

'Verify that the proposed sheet name does not already exist in the workbook.
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = WorksheetFunction.Trim(mySheetName)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If

'If the worksheet name does not already exist, name the active sheet as the InputBox entry.
'Otherwise, advise the user that duplicate sheet names are not allowed.
If bln = False Then
ActiveSheet.Name = strSheetName
Else
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Please enter a unique name for this sheet.", 16, "Duplicate sheet names not allowed."
End If

End Sub

 

[Simon Lloyd]

For your original code you had If NOT wsSHeet Is Nothing, you needed to lose the NOT

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim wsSheet As Worksheet
' Only look at single cell changes
If Target.Cells.Count > 1 Then Exit Sub
'add date when user is selected
If Target.Column = 2 And Target.Row = 2 Then
    If Target <> "" And Target.Offset(, 2).Value = "" Then
        Target.Offset(, 2) = Date
    Else
        Target.Offset(, 2) = ""
    End If
End If
'delete location when pallet entered
If Target.Column = 2 And Target.Row = 3 Then
    If Target <> "" Then
        Target.Offset(, 2) = ""
        On Error Resume Next
        Set wsSheet = Sheets(Cells(3, 2).Value)
'determining if the worksheet name already exists
            If wsSheet Is Nothing Then
                ActiveSheet.Name = InputBox("Sheet", "Enter Sheet Name", Cells(3, 2).Value)
                Set wSheet = Nothing
                On Error GoTo 0
            Else
                ActiveSheet.Name = "Pallet " & Cells(3, 2).Value
                Set wSheet = Nothing
                On Error GoTo 0
            End If
    End If
End If
End Sub

 

[TLA]

Tom,

I did consider sheet name length, the cells they are using are validated, one is a drop down and one is a number that can't be more than 5 digits long. I was limiting the question to my issue, which was just the duplicate names. I'm not filling in B3 or D3 with a date That's a seperate cell (B2 fills D2 with a date when it is entered).

B3 and D3 clear each other (they are mutually exclusive) and then name the sheet to what is in either cell.

I'd much prefer to name the sheet automatically, with a -(Next highest number). Instead of checking for invalid characters or relying on an input box.
I should be able to take the sheet dup check code from here and loop around to find the first sheet that does not exist.

 

[TLA]

Ok I am still having the same issue. The function always seems to execute the same way when the sheet exists or not. I'll focus on just this part of the code:

There are two possible values (let's say) for Cell D3
"C&T"
"Deployment"

There is currently a sheet in the workbook named "Loc-C&T"
I have disabled the sheet renaming as you can see it's commented out, I just want to know if the sheet exists.
When i select C&T the cell it says "Sheet Doesn't Exist"
When I select "Deployment in the cell it says "Sheet Doesn't Exist"



If Target.Column = 4 And Target.Row = 3 Then
If Target <> "" Then
Target.Offset(, -2) = ""
MySheetName = "Loc-" & Cells(3, 4).Value
If SheetExists(MySheetName) = True Then
MsgBox "Sheet Exists"
Else
MsgBox "Sheet Doesn't Exist"
End If
'ActiveSheet.Name = "Loc-" & Cells(3, 4).Value
Exit Sub
End If
End If
---------------------------------------------------------------
Function SheetExists(Mysheet)
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = WorksheetFunction.Trim(MySheetName)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
SheetExists = True
Else
SheetExists = False
Err.Clear
End If
End Function

 

[TLA]

F&%*(^*
The Function variable was wrong. My bad.

 

[TLA]

Got it working with this code:

If Target.Column = 4 And Target.Row = 3 Then
If Target <> "" Then
Target.Offset(, -2) = ""
While bln = False
MysheetName = "Loc-" & Cells(3, 4).Value & mySheetSuffix
If SheetExists(MysheetName) = True Then
X = X + 1
mySheetSuffix = "-" & X
Else
ActiveSheet.Name = MysheetName
bln = True
End If
Wend
Exit Sub
End If
End If

Function SheetExists(MysheetName)
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = WorksheetFunction.Trim(MysheetName)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
SheetExists = True
Else
SheetExists = False
Err.Clear
End If
End Function


Thanks for pointing me in the right direction