PDA

View Full Version : [SOLVED] Name a worksheet after a cell



blarkdirth
01-26-2005, 03:37 PM
I am hoping to find a way of renaming worksheets based on the contents of cell A1 in all of the sheets

The contents of A1 will be a name eg Fred Bloggs

I want the sheets to be the initials eg FB

There will need to be a check so that if any initials are the same the sheets are named FB1 and FB2 or similar

If possible it would also be good if, once the sheets are renamed they could be moved into alphabetical order (with the second initial being the sort ) ie Bloggs before Brown

I know I am probably pushing my luck a bit!

Appreciate any help / suggestions where to start!

Mark

Jacob Hilderbrand
01-26-2005, 04:05 PM
This will rename the sheet. Note I didn't add the Error Handling for duplicate sheet names.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NameString As String
Dim n As Long
Dim Initials As String
NameString = Range("A1").Text
n = InStr(1, NameString, " ")
Initials = Left(NameString, 1) & Mid(NameString, n + 1, 1)
ActiveSheet.Name = Initials
End Sub

You can see how to sort worksheets Here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=72).

Zack Barresse
01-26-2005, 04:07 PM
This is somewhat similar to DRJ's, although I have put in the error handling for multiple worksheets in a sequential number ordering. ...


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, n As Long, cnt As Long, fName As String, fLen As Long
If Target.Address <> "$A$1" Then Exit Sub 'check for addy
If Target.Value = "" Then Exit Sub 'check for blank
Application.ScreenUpdating = False
Application.DisplayAlerts = False
cnt = 0
For i = Len(Target) To 1 Step -1
If Mid(Target, i, 1) = Chr$(32) Then Exit For
Next i
fName = Left$(Target, 1) & Mid(Target, i + 1, 1)
fLen = Len(fName)
checkAgain:
If Me.Name = fName Then GoTo exitHere
If CheckSheet(fName) Then
cnt = cnt + 1
fName = Left$(fName, fLen) & cnt
GoTo checkAgain
End If
Me.Name = fName
exitHere:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Function CheckSheet(wsName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets(wsName)
On Error GoTo 0
CheckSheet = IIf(ws Is Nothing, False, True)
End Function

Let me know how it works for you.

blarkdirth
01-28-2005, 10:50 AM
Thanks to you both

Both do what I need - Zacks code adds 1 on the end of each occasion of a duplicate

I will experiment with the sorting into surname / second initial sequence

Regards

:friends: Mark

Jacob Hilderbrand
01-28-2005, 04:40 PM
You're Welcome :beerchug:

To sort the sheets check out This KB Entry (http://www.vbaexpress.com/kb/getarticle.php?kb_id=72).

blarkdirth
02-02-2005, 06:37 AM
Having looked at Dreamboat's sorting code, it will do what I need in part but I was wondering if it could be amended to sort alphabetically by the second letter of the sheet name.

Regards

Mark :spidereek

Jacob Hilderbrand
02-02-2005, 07:12 AM
Try this code to sort by the second letter of the worksheet name.

Option Explicit

Sub SortSheets()

Dim i As Long
Dim n As Long
Dim AppExcel As New Excel.Application
Dim WS As Worksheet
Dim Wkb As Workbook

Set Wkb = AppExcel.Workbooks.Add
Set WS = Wkb.Sheets(1)
n = ThisWorkbook.Sheets.Count
For i = 1 To n
WS.Range("A" & i).Value = _
Right(ThisWorkbook.Sheets(i).Name, _
Len(ThisWorkbook.Sheets(i).Name) - 1)

WS.Range("B" & i).Value = ThisWorkbook.Sheets(i).Name
Next i
WS.Range("A1:B" & n).Sort Key1:=WS.Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
For i = 1 To n
ThisWorkbook.Sheets(WS.Range("B" & i).Text).Move _
After:=ThisWorkbook.Sheets(n)
Next i

Wkb.Close False
AppExcel.Quit

Set WS = Nothing
Set Wkb = Nothing
Set AppExcel = Nothing

End Sub

blarkdirth
02-02-2005, 08:03 AM
Thanks Jake

It now sorts by the second letter , but ignores the first ie a sheet name EE could be sorted after cell GE depending on where it was to start.

Any ideas how to amend it

I appreciate your help

Mark
:doh:

Jacob Hilderbrand
02-02-2005, 08:11 AM
So how do you want to sort by? Second letter, then first, then third, fourth, fifth??

blarkdirth
02-02-2005, 09:48 AM
Thanks Jake

Sorry - I haven't made it very clear have I!!? :confused2

I am running code kindly given by your good self on my previous post which reduces the sheet name to two letters which in my situation will be firstname and surname initials

I want to sort all worksheets by the second letter (ie surname initial) and then by first name intial. ie the sheet name MF would be before RF

There should be no other third fourth or fifth letters to sort by.

I appreciate your patience!

Mark
:friends:

Jacob Hilderbrand
02-02-2005, 03:10 PM
Try this.

Option Explicit

Sub SortSheets()

Dim i As Long
Dim n As Long
Dim AppExcel As New Excel.Application
Dim WS As Worksheet
Dim Wkb As Workbook
Dim Temp As String
Set Wkb = AppExcel.Workbooks.Add
Set WS = Wkb.Sheets(1)
n = ThisWorkbook.Sheets.Count
For i = 1 To n
Temp = ThisWorkbook.Sheets(i).Name
WS.Range("A" & i).Value = Right(Temp, 1)
WS.Range("B" & i).Value = Left(Temp, 1)
WS.Range("C" & i).Value = Temp
Next i
WS.Range("A1:C" & n).Sort Key1:=WS.Range("A1"), Order1:=xlAscending, _
Key1:=WS.Range("B1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
For i = 1 To n
ThisWorkbook.Sheets(WS.Range("C" & i).Text).Move _
After:=ThisWorkbook.Sheets(n)
Next i

AppExcel.Visible = True

Wkb.Close False
AppExcel.Quit

Set WS = Nothing
Set Wkb = Nothing
Set AppExcel = Nothing

End Sub

Anne Troy
02-25-2005, 01:41 PM
Dreamboat's sorting code

ROFL!! Wonder where I stole that!??
(I'm no coder, blarkdirth)

K. Georgiadis
03-01-2005, 07:51 PM
I have a question regarding Chuck Pearson's code to re: sorting worksheets alphabetically that was referenced in this thread. He explains that his code can be modified to start on Sheet1, Sheet2 or wherever. Is it possible to modify this code so that it only sorts a certain set of sheets, say for example, only sort from Sheet8 to Sheet20?