Hi Everyone....
Im not very good in English but I hope I can convey my excel problem and someone can help me.
What I need:
1). - I wanted data in the Cell (in this example let's just say A1) to be the name of the worksheet... For this example, this Cell is in SHEET 2
2). - While in Sheet1 is a LIST of data with names...
3). - In Sheet2, I use VLOOKUP to get the name for A1 Cell.
I have found two VBA Codes
VBA Code 1
- It works well but when I use vlookup, the cells changes but it doesnt change the worksheet name, it gets stuck in the first option.
VBA Code 2
- It works well, changes in the cell reflects the worksheet name... but has some limits..
PROBLEM:
I would like to incorporate or combine VBA Code 2 inside VBA Code 1...
I HOPE SOMEONE CAN SHOW ME HOW TO COMBINE THESE 2 CODES
Below are the codes
VBA Code 1
---------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
If IsEmpty(Target) Then Exit Sub
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
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
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 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
---------------------------------------------------------------------
VBA Code2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
On Error Resume Next
If Not Intersect(Target, Range("A1")) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("A1")
End If
Application.EnableEvents = False
Set xRg = ActiveSheet.Range("A1").Precedents
If Not xRg Is Nothing Then
For Each xCell In xRg
ActiveSheet.Name = ActiveSheet.Range("A1")
Next
End If
Application.EnableEvents = True
End Sub
-------------------------------------------------------------------------------------
Im not very good in English but I hope I can convey my excel problem and someone can help me.
What I need:
1). - I wanted data in the Cell (in this example let's just say A1) to be the name of the worksheet... For this example, this Cell is in SHEET 2
2). - While in Sheet1 is a LIST of data with names...
3). - In Sheet2, I use VLOOKUP to get the name for A1 Cell.
I have found two VBA Codes
VBA Code 1
- It works well but when I use vlookup, the cells changes but it doesnt change the worksheet name, it gets stuck in the first option.
VBA Code 2
- It works well, changes in the cell reflects the worksheet name... but has some limits..
PROBLEM:
I would like to incorporate or combine VBA Code 2 inside VBA Code 1...
I HOPE SOMEONE CAN SHOW ME HOW TO COMBINE THESE 2 CODES
Below are the codes
VBA Code 1
---------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
If IsEmpty(Target) Then Exit Sub
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
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
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 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
---------------------------------------------------------------------
VBA Code2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
On Error Resume Next
If Not Intersect(Target, Range("A1")) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("A1")
End If
Application.EnableEvents = False
Set xRg = ActiveSheet.Range("A1").Precedents
If Not xRg Is Nothing Then
For Each xCell In xRg
ActiveSheet.Name = ActiveSheet.Range("A1")
Next
End If
Application.EnableEvents = True
End Sub
-------------------------------------------------------------------------------------