View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
job job is offline
external usenet poster
 
Posts: 65
Default 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