Sheetname Changes Depending on Cell Input Data

[wedzmer]

Hi everyone!

I would like my worksheet name to change depending on the result of a certain cell thus copying that result as the new sheetname.

Example, Sheet 1 would change if cell B1 result would be: "MATHEMATICS".

 

[John_w]

In the worksheet class module:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$1" Then
        Me.Name = Target.Value
    End If
End Sub

 

[Momentman]

In the worksheet class module:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$1" Then
        Me.Name = Target.Value
    End If
End Sub

Some cell values containing special characters might spring up an error. Like a slash or......

 

[wedzmer]

In the worksheet class module:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$1" Then
        Me.Name = Target.Value
    End If
End Sub

where exactly would I insert that here in my VBA?

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub


    On Error Resume Next
    If Not Intersect(Target, Range("b12:B131")) Is Nothing Then
        Application.EnableEvents = False
        Target = UCase(Target)
        Application.EnableEvents = True
    End If
    On Error GoTo 0


End Sub

 

[wedzmer]

Some cell values containing special characters might spring up an error. Like a slash or......

how could that be fixed?

 

[John_w]

Some cell values containing special characters might spring up an error. Like a slash or......

Yes, of course. See http://www.mrexcel.com/forum/excel-questions/461398-removing-invalid-characters-sheet-name.html for invalid characters and how to remove them.

 

[John_w]

where exactly would I insert that here in my VBA?

You could use an If...Then... Else... structure like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

    If Target.Address = "$B$1" Then
        Me.Name = Target.Value
    Else
        On Error Resume Next
        If Not Intersect(Target, Range("b12:B131")) Is Nothing Then
            Application.EnableEvents = False
            Target = UCase(Target)
            Application.EnableEvents = True
        End If
        On Error GoTo 0
    End If

End Sub

 

[wedzmer]

You could use an If...Then... Else... structure like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

    If Target.Address = "$B$1" Then
        Me.Name = Target.Value
    Else
        On Error Resume Next
        If Not Intersect(Target, Range("b12:B131")) Is Nothing Then
            Application.EnableEvents = False
            Target = UCase(Target)
            Application.EnableEvents = True
        End If
        On Error GoTo 0
    End If

End Sub

unfortunately it is not working....

Option ExplicitPrivate Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
Application.EnableEvents = False
On Error GoTo ErrH
If Target.Address = "$a$6" Then
Me.Name = Target
Application.EnableEvents = True
Exit Sub
End If


If Not Intersect(Target, Range("b12:B131")) Is Nothing Then
Target = UCase(Target)
End If
Application.EnableEvents = True
Exit Sub


ErrH:
MsgBox "Invalid Worksheet Name"
Application.EnableEvents = True
End Sub


Sub HideRow()
Dim lLastRow As Long
Dim lCounter As Long


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

With ActiveSheet

.Unprotect
.Shapes("Button 1").Visible = False


lLastRow = .Range("E65536").End(xlUp).Row
For lCounter = 14 To lLastRow
If .Cells(lCounter, "E").Value = 1 Then
.Cells(lCounter, "E").EntireRow.Hidden = True
'Else: .Cells(lCounter, "E").EntireRow.Hidden = False
End If
Next lCounter
.Range("G12").Select


.Shapes("Button 2").Visible = True
End With


Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True


End Sub


Sub UnHideRow()


With ActiveSheet
.Unprotect
.Rows.Hidden = False
.Shapes("Button 1").Visible = True
.Shapes("Button 2").Visible = False
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With


End Sub


Sub CopySheet()
ActiveSheet.Copy After:=ActiveSheet
End Sub

Maybe because the cell target is a dropdown data validation list.. is that it?