Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim actionRange As Range, actionAddress As String
Dim uiName As String, uiAction As Long
Dim strPrompt As String, strDefault As String
Dim nameCell As Range
Dim linkedSheets As Sheets, oneSheet As Worksheet
Set linkedSheets = ThisWorkbook.Worksheets
actionAddress = "A:A"
For Each oneSheet In linkedSheets
If oneSheet.Name = Sh.Name Then
Set actionRange = Sh.Range(actionAddress)
Set actionRange = Application.Intersect(actionRange, Target)
End If
Next oneSheet
If Not actionRange Is Nothing Then
If Target.Cells.Count = 1 Then
Set nameCell = Target.Cells(1, 1)
strDefault = CStr(nameCell.Value)
If strDefault = vbNullString Then
strPrompt = "Enter the new name"
Else
strPrompt = "Edit the name."
End If
uiName = Application.Proper(Application.InputBox(strPrompt, Default:=strDefault, Type:=2))
If uiName = "False" Then GoTo Canceled
If strDefault = vbNullString Then
strPrompt = "Add " & uiName & " as a new name."
uiAction = MsgBox(strPrompt, vbOKCancel)
Else
strPrompt = "Yes - change " & strDefault & " to " & uiName & "."
strPrompt = strPrompt & vbCr & vbCr & "No - add " & uiName & " as a new name."
uiAction = MsgBox(strPrompt, vbYesNoCancel)
End If
If (strDefault = uiName) And (uiAction = vbYes) Then uiAction = vbCancel
Select Case uiAction
Case vbNo, vbOK
Rem new name
With nameCell.EntireColumn
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = uiName
End With
Case vbYes
Rem edit name
nameCell.Value = uiName
Case vbCancel
GoTo Canceled
End Select
On Error GoTo Canceled
Application.EnableEvents = False
With nameCell.EntireColumn
With Range(.Cells(1, 1), .Cells(.Rows.Count).End(xlUp))
linkedSheets.FillAcrossSheets .Cells
End With
End With
For Each oneSheet In linkedSheets
With oneSheet
With Range(.UsedRange, .Cells(1, 1))
.Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End With
Next oneSheet
End If
Canceled:
Application.EnableEvents = False
Target.Offset(0, 1).Select
Application.EnableEvents = True
End If
End Sub