Rename Worksheet cell value in another worksheet

[dsrt16]

I have renamed worksheets according to a cell value in the same worksheet, but now I need to rename the worksheet according to a cell value in another worksheet.

Here is the code I tried:

Private Sub Worksheet_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sheets("Set-Up Page").Range("B2").Value <> "" Then
        'rename the worksheet to the contents of cell B2
        Sh.Name = Sheets("Set-up Page").Range("B2").Value
    End If

End Sub

I have pasted that code into the worksheet that needs to be renamed, but it doesn't work. I have also tried:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = Sheets("Set-up Page").Range("B2") Then Sh.Name = Target
End Sub

I like the first one because it checks for a blank value. There will be blank values depending on how many worksheets each teacher needs, so it will just rename the ones that have values filled in. Each worksheet will have the code referencing to a different cell on the Set-Up Page worksheet.

 

[GTO]

Worksheet_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Heyyyy, no fair trying to make up events! I am teasing of course, but change events are Worksheet_Change(ByVal Target As Range) for the worksheet (placed in the worksheet's module) and Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) for the workbook level event (Placed in ThisWorkbook module).

I am sorry not to be of more help, but I am not grasping how this would continue to work? Writing code for each sheet, just to rename it seems unlikely, so I figure you want one event to cover all the sheets. If that is the case however, how would one prevent naming two sheets the same name (which blows up)?

Mark

 

[dsrt16]

Well I was trying to make something up...haha!

But I played around some more, and I got it to work with the following code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Name = Sheets("Set-up Page").Range("B2").Value
End Sub

And yes I need to rename each sheet a student's name that is entered into the set-up page. The workbook has 30 different worksheets, and each one needs to be renamed according to the names listed on the set-up page. Every teacher has different student names, which is why I have to write code to rename each sheet to reference whatever the teacher places in that cell! :D

 

[brettdj]

This is probably code best written to fire manually rather than on a repetitive basis - I can't imagine that the set-up page changes that frequently

Plus you should add error handlers to cater for
- the sheet name already existing
- invalid characters in a student name

Both may be unlikely, but worth testing for

We can help with this if it is useful

Cheers

Dave

 

[Biz]

This is probably code best written to fire manually rather than on a repetitive basis - I can't imagine that the set-up page changes that frequently

Plus you should add error handlers to cater for
- the sheet name already existing
- invalid characters in a student name

Both may be unlikely, but worth testing for

We can help with this if it is useful

Cheers

Dave

Dave nice pick up. I have used remove illegal characters

'letters only
Function ReplaceSpecial(ByVal Txt As String) As String
With CreateObject("VBScript.RegExp")
    .Pattern = "[^A-Z\s]+"
    .Global = True
    .IgnoreCase = True
    ReplaceSpecial = Application.Trim(.Replace(Txt, ""))
End With
End Function

Using formula below remove spaces.

SUBSTITUTE(ReplaceSpecial(A2)," ","_")


Biz

 

[dsrt16]

This is probably code best written to fire manually rather than on a repetitive basis - I can't imagine that the set-up page changes that frequently.

For now, I am using the code I posted, simply because it works. However, if there is a better way, by all means share. I took a VBA course a while back, so I am very rusty and very basic.

Essentially, I am creating a template and every teacher at my school will open the template and enter their students names into the set-up page. (later to save as their own workbook) Currently, each worksheet contains the code directing the worksheet to be labeled according to a different cell entry on the set-up page. A1, A2, A3 etc, so each worksheet will be named a different student.

The set-up page will change from time to time as new students will leave and enter the program. So if student in cell A3 leaves the AI program, but a new student is registered for AI then a new name would be typed in cell A3, and the worksheet referencing A3 would need to change its name to reflect. Also, some teachers will get new kids at the semester change.

The code I have now works, but if there is a better way. Feel free to share!

 

[dsrt16]

BrettDJ--

There is something that doesn't work in my current set-up. I have allotted room for 25 student entries, but some teachers will have as few as 5. So the debugger tries to run if the teacher clicks on a worksheet that doesn't have a cell to reference.

So if worksheet 12 references cell N2, and there is nothing in cell N2 because that teacher only has 11 students, the debugger will run if the teacher clicks on worksheet 12.

I do need to have a line for what to do if nothing is entered in the reference cell. Right now, I have all the worksheets labeled a number 1-25, so I want that worksheet to stay labeled that number if nothing is entered in its reference cell.

Even better can I have it HIDE the worksheet if nothing in the reference cell. So hide worksheet 12 if nothing is entered into N2. Then unhide if the teacher gets a new student and has to label N2.

How do I do that?

(hmm should I post this in a different thread since this is now about something different?? Sorry if I didn't address this correctly)

 

[brettdj]

Okay - here goes

This is the "one-off" code I was mentioning, it only needs to be run when you have a new list of names. I have not added delete code to remove any extra sheets (say if you went from 20 people to 11), this can be done if useful

This code will handle a variable list of names starting from A2 in Sheet "Set-up Page" which must be the first sheet in the file

The code checks to avoid blank cells, and uses the nice regexp from Biz to clean the strings of non alphabetic/space characters

It then names each sheet, and create a hyperlinked index in B2, C2 etc

Warnings are given if there are duplicate sheet names, or not enough sheets

Cheers

Dave

Sub MakeSheetNames()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim objDic
    Dim strTmp As String
    Dim strErr As String
    Dim lngCnt As Long
    Set objDic = CreateObject("scripting.dictionary")
    Set ws1 = ThisWorkbook.Sheets("Set-up Page")
    If ws1.Index <> 1 Then
        MsgBox "This code assumes the Set-up sheet is the first worksheet, please reorder sheets and retry"
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Set rng1 = ws1.Range(ws1.[a2], ws1.Cells(Rows.Count, "A").End(xlUp))
    lngCnt = 1
    For Each rng2 In rng1
        strTmp = CleanString(rng2.Value)
        If Len(strTmp) > 0 Then
            If Not objDic.exists(strTmp) Then
                lngCnt = lngCnt + 1
                If ThisWorkbook.Sheets.Count < lngCnt Then
                    MsgBox "You only have " & ThisWorkbook.Sheets.Count & " sheets for renaming" & vbNewLine & "Please add more sheets then rerun"
                Else
                    ThisWorkbook.Sheets(lngCnt).Name = strTmp
                    objDic.Add (strTmp), lngCnt
                    With rng2.Offset(0, 1)
                        .Hyperlinks.Add Anchor:=rng2.Offset(0, 1), Address:="", SubAddress:="'" & strTmp & "'!A1", TextToDisplay:=ThisWorkbook.Sheets(lngCnt).Name
                        .Font.Bold = True
                        .Font.ColorIndex = 41
                    End With
                End If
            Else
                strErr = strErr & strTmp & vbNewLine
            End If
        End If
    Next
    If Len(strErr) > 0 Then MsgBox "These sheets were duplicated:" & vbNewLine & strErr
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

Function CleanString(strIn As String) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = "[^A-Z\s]+"
        .Global = True
        .IgnoreCase = True
        CleanString = Application.Trim(.Replace(strIn, ""))
    End With
End Function

 

[dsrt16]

BrettDj--

Your code works perfectly. Thanks! I just commented out the with section of code that created the hyperlinked indexes because I did not need that.

Thanks so much! I would never have been able to do that. I wish I knew advanced coding; it looks fun! Maybe one day when I have enough time to actually take classes or read up on it. :D

 

[brettdj]

No probs

fwiw, I taught myself by solving other people's problems on the online forums. That had the advantage of quickly broadening my horizons beyond the natural limits of a book

The code above has most of the logic devoted to handling problems rather than actual doing.

Cheers

Dave