VBA naming a worksheet via cells

Dexter73

New Member
Joined
Feb 16, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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
-------------------------------------------------------------------------------------
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,223,897
Messages
6,175,269
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top