ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   name worksheet after value in a given cell (https://www.excelbanter.com/excel-programming/343484-name-worksheet-after-value-given-cell.html)

simon

name worksheet after value in a given cell
 
I'd like to have a workbook with all the worksheets being named from
whatever the value is in a given cell.

I.E
Worksheet2 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"
Worksheet3 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"
Worksheet4 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"

How can I acheive this?

SS



job

name worksheet after value in a given cell
 
Hi Simon.

This code will insert a sheet for each item in a list and name the sheet the
cell value. Make sure you highlight the list then run the code.

Cheers,

Job

Sub insertsheetfromlist()
'
Application.ScreenUpdating = False
On Error GoTo Whoops
actsheet = ActiveSheet.Name
shtcnt = Worksheets.Count
For Each C In Selection.Cells
shtlen:
If Len(C) 31 Then
Message = "The cell " & C.Address(RowAbsolute:=False) & "
contains a name " & vbCrLf & _
" that exceeds 31 characters." & vbCrLf & _
"Type A Shorter Name"
Title = "Name too long." ' Set title.
shtnme = InputBox(Message, Title, C.Value)
If Len(shtnme) 31 Then GoTo shtlen
If shtnme = "" Then
shtcnt2 = Worksheets.Count
If shtcnt < shtcnt2 Then
Application.DisplayAlerts = False
For i = 1 To shtcnt2 - shtcnt
Sheets(Worksheets.Count).Delete
Next i
Sheets(actsheet).Select
Application.DisplayAlerts = True
End If
MsgBox "The proceedure was rolled back and cancelled."
Exit Sub
End If

End If
If Len(shtnme) < 1 Then
Sheets.Add.Name = C.Value
ActiveSheet.Move After:=Sheets(Sheets.Count)
Sheets(actsheet).Select
Else
Sheets.Add.Name = shtnme
ActiveSheet.Move After:=Sheets(Sheets.Count)
Sheets(actsheet).Select
shtnme = ""
End If
Next C

Whoops:
Application.DisplayAlerts = False
If Err.Number = 1004 Then
shtcnt2 = Worksheets.Count
If shtcnt < shtcnt2 Then
For i = 1 To shtcnt2 - shtcnt
Sheets(Worksheets.Count).Delete
Next i
End If
Sheets(actsheet).Select
Application.DisplayAlerts = True
MsgBox "The sheet name " & C.Value & "(" &
C.Address(RowAbsolute:=False) & ")" & " already exists." & vbCrLf & _
"Please check list and try again."
End If
Application.ScreenUpdating = True
End Sub

Watch for word wrap...

"simon" wrote in message
...
I'd like to have a workbook with all the worksheets being named from
whatever the value is in a given cell.

I.E
Worksheet2 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"
Worksheet3 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"
Worksheet4 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"

How can I acheive this?

SS




simon

name worksheet after value in a given cell
 
Job.

Thanks for that - however I dont want it to create the sheets.
The sheets will already exist.

I just want each sheet to be named after the value in whichever cell I
decide should be the source name data.

Can you assist further?

SS



Norman Jones

name worksheet after value in a given cell
 
Hi Simon,

Try something like:
'================
Public Sub Tester001()
Dim SH As Worksheet
Const sStr As String = "D5" '<<==== CHANGE

On Error GoTo ErrHandler
For Each SH In ThisWorkbook.Worksheets
SH.Name = SH.Range(sStr).Value
Next SH
Exit Sub
ErrHandler:
MsgBox "Cell " & sStr & " on sheet " & SH.Name _
& " is not a valid sheet name"
Resume Next
End Sub
'================

---
Regards,
Norman


"simon" wrote in message
...
I'd like to have a workbook with all the worksheets being named from
whatever the value is in a given cell.

I.E
Worksheet2 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"
Worksheet3 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"
Worksheet4 - Value in Cell D5 = "some text derived from elsewhere in the
sheet"

How can I acheive this?

SS





All times are GMT +1. The time now is 09:01 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com