U_Shrestha
07-13-2008, 11:34 AM
Hi,
The following magical code was given by JimmyTheHand; when a text is typed in column A (A3:A), the code creates a new sheet and alphabetically sorts the sheets as wells as texts in the column A, while always keeping the sheet "Menu" as the first sheet in the workbook.
My next request is, can the code also automatically insert a hyperlink (or anything with macro) when a text is added in A3:A? The procedure should be this, when a text, e.g. "Umesh" is typed in A3:A, a new sheet will be created, sort the sheets alphabetically without touching the "Menu" Sheet, sort the text in Column A3:A (leaving the table heading) AND insert hyperlink in the newly added text to the sheet named "Umesh" in A1, so that when you click that sheet name, you can reach A1 of the newly created sheet, and add a text "Menu" in A1 of "Umesh" which would have a hyperlink to the sheet "Menu".
Jimmy, I was wondering what does "Munka" mean in the sample workbook (attached) in your code/example Thanks.
Dim WS As Worksheet, rngNames As Range, cel As Range, Answ
Set rngNames = Range("A3", Range("A" & Rows.Count).End(xlUp))
If Intersect(Target, rngNames) Is Nothing Then Exit Sub
Application.EnableEvents = False
'check and remove duplicate names
For Each cel In Target
If NameCount(rngNames, cel.Value) > 1 Then
Answ = MsgBox("Duplicate name found: " & cel & vbLf & "Remove? (Click 'No' to rename)", vbYesNo)
If Answ = vbYes Then
cel.ClearContents
Else
Do
Answ = InputBox("Enter a unique name!")
Loop Until NameCount(rngNames, Answ) = 1
cel.Value = Answ
End If
End If
Next
'sort names
Range(rngNames, rngNames.End(xlToRight)).Sort key1:=Range("A2"), order1:=xlAscending
Application.EnableEvents = True
'set range again to exclude deleted names
Set rngNames = Range("A3", Range("A" & Rows.Count).End(xlUp))
'Move sheet "Menu" to 1st position
Me.Move Before:=Sheets(1)
'Add and sort sheets
For Each cel In rngNames
If WorksheetExist(cel.Value, WS) Then
WS.Move After:=Sheets(cel.Row - 2)
Else
Set WS = Sheets.Add(After:=Sheets(cel.Row - 2))
WS.Name = cel.Value
WS.Move After:=Sheets(cel.Row - 2)
End If
Next
Application.DisplayAlerts = False
'Upon confimation, remove unlisted sheets
For Each WS In ThisWorkbook.Worksheets
If (Not WS Is Me) And (NameCount(rngNames, WS.Name) = 0) Then
WS.Activate
Answ = MsgBox("Sheetname " & WS.Name & " not found in the list. Remove sheet?", vbYesNo)
If Answ = vbYes Then WS.Delete
End If
Next
Application.DisplayAlerts = True
Me.Activate
End Sub
Private Function WorksheetExist(Name As String, WS As Worksheet) As Boolean
On Error GoTo EH
Set WS = Sheets(Name)
WorksheetExist = True
EH:
End Function
Private Function NameCount(Rng As Range, Name) As Long
NameCount = Application.WorksheetFunction.CountIf(Rng, Name)
End Function
The following magical code was given by JimmyTheHand; when a text is typed in column A (A3:A), the code creates a new sheet and alphabetically sorts the sheets as wells as texts in the column A, while always keeping the sheet "Menu" as the first sheet in the workbook.
My next request is, can the code also automatically insert a hyperlink (or anything with macro) when a text is added in A3:A? The procedure should be this, when a text, e.g. "Umesh" is typed in A3:A, a new sheet will be created, sort the sheets alphabetically without touching the "Menu" Sheet, sort the text in Column A3:A (leaving the table heading) AND insert hyperlink in the newly added text to the sheet named "Umesh" in A1, so that when you click that sheet name, you can reach A1 of the newly created sheet, and add a text "Menu" in A1 of "Umesh" which would have a hyperlink to the sheet "Menu".
Jimmy, I was wondering what does "Munka" mean in the sample workbook (attached) in your code/example Thanks.
Dim WS As Worksheet, rngNames As Range, cel As Range, Answ
Set rngNames = Range("A3", Range("A" & Rows.Count).End(xlUp))
If Intersect(Target, rngNames) Is Nothing Then Exit Sub
Application.EnableEvents = False
'check and remove duplicate names
For Each cel In Target
If NameCount(rngNames, cel.Value) > 1 Then
Answ = MsgBox("Duplicate name found: " & cel & vbLf & "Remove? (Click 'No' to rename)", vbYesNo)
If Answ = vbYes Then
cel.ClearContents
Else
Do
Answ = InputBox("Enter a unique name!")
Loop Until NameCount(rngNames, Answ) = 1
cel.Value = Answ
End If
End If
Next
'sort names
Range(rngNames, rngNames.End(xlToRight)).Sort key1:=Range("A2"), order1:=xlAscending
Application.EnableEvents = True
'set range again to exclude deleted names
Set rngNames = Range("A3", Range("A" & Rows.Count).End(xlUp))
'Move sheet "Menu" to 1st position
Me.Move Before:=Sheets(1)
'Add and sort sheets
For Each cel In rngNames
If WorksheetExist(cel.Value, WS) Then
WS.Move After:=Sheets(cel.Row - 2)
Else
Set WS = Sheets.Add(After:=Sheets(cel.Row - 2))
WS.Name = cel.Value
WS.Move After:=Sheets(cel.Row - 2)
End If
Next
Application.DisplayAlerts = False
'Upon confimation, remove unlisted sheets
For Each WS In ThisWorkbook.Worksheets
If (Not WS Is Me) And (NameCount(rngNames, WS.Name) = 0) Then
WS.Activate
Answ = MsgBox("Sheetname " & WS.Name & " not found in the list. Remove sheet?", vbYesNo)
If Answ = vbYes Then WS.Delete
End If
Next
Application.DisplayAlerts = True
Me.Activate
End Sub
Private Function WorksheetExist(Name As String, WS As Worksheet) As Boolean
On Error GoTo EH
Set WS = Sheets(Name)
WorksheetExist = True
EH:
End Function
Private Function NameCount(Rng As Range, Name) As Long
NameCount = Application.WorksheetFunction.CountIf(Rng, Name)
End Function