vanhunk
06-03-2013, 06:43 AM
Add entry into one sheet into a list in another by triggering a worksheet change event:
Hi there,
I would appreciate some help, I tried a number of things without success.:banghead:
I have a Template spreadsheet with the code below. The code changes the name of the current sheet with whatever is typed into A3 of the current sheet.
What I want to achieve is to whenever the code below is activated, to have it check on another sheet called “Names List”, to see if what is typed into A3 of the current sheet, is present in the “Names List” sheet, in the list below the heading “Names” with the defined name of “NamesList”. If it does, nothing further is required, if it is not, it must be added to the list.
In the sheet “Names List”:
Names
Koos
Jan
Piet
If I now type "Willem" into cell A3 of the "Template" sheet, "Willem" must be added below "Piet" in the "Names List" sheet.
The code I got from one of the forums and which I want to expand follows:
Private Sub Worksheet_Change(ByVal Target As Range)
'Specify the target cell whose entry shall be the sheet tab name.
If Target.Address <> "$A$3" Then Exit Sub
'If the target cell is empty (contents cleared) then do not change the sheet name
If IsEmpty(Target) Then Exit Sub
'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
If Len(Target.Value) > 31 Then
MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
"You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
'Verify that none of these characters are present in the cell's entry.
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
"Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
Next i
'Verify that the proposed sheet name does not already exist in the workbook.
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = Trim(Target.Value)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If
'If the worksheet name does not already exist, name the active sheet as the target cell value.
'Otherwise, advise the user that duplicate sheet names are not allowed.
If bln = False Then
ActiveSheet.Name = strSheetName
Else
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Please enter a unique name for this sheet."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Hi there,
I would appreciate some help, I tried a number of things without success.:banghead:
I have a Template spreadsheet with the code below. The code changes the name of the current sheet with whatever is typed into A3 of the current sheet.
What I want to achieve is to whenever the code below is activated, to have it check on another sheet called “Names List”, to see if what is typed into A3 of the current sheet, is present in the “Names List” sheet, in the list below the heading “Names” with the defined name of “NamesList”. If it does, nothing further is required, if it is not, it must be added to the list.
In the sheet “Names List”:
Names
Koos
Jan
Piet
If I now type "Willem" into cell A3 of the "Template" sheet, "Willem" must be added below "Piet" in the "Names List" sheet.
The code I got from one of the forums and which I want to expand follows:
Private Sub Worksheet_Change(ByVal Target As Range)
'Specify the target cell whose entry shall be the sheet tab name.
If Target.Address <> "$A$3" Then Exit Sub
'If the target cell is empty (contents cleared) then do not change the sheet name
If IsEmpty(Target) Then Exit Sub
'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
If Len(Target.Value) > 31 Then
MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
"You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
'Verify that none of these characters are present in the cell's entry.
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
"Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
Next i
'Verify that the proposed sheet name does not already exist in the workbook.
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = Trim(Target.Value)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If
'If the worksheet name does not already exist, name the active sheet as the target cell value.
'Otherwise, advise the user that duplicate sheet names are not allowed.
If bln = False Then
ActiveSheet.Name = strSheetName
Else
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Please enter a unique name for this sheet."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub