I have been trying unsuccessfully to find a macro that will get data from a
cell range on one sheet and change the worksheet names on another 10 sheets
to each of the names in that cell range. Can anyone offer a solution please?
I have been trying unsuccessfully to find a macro that will get data from a
cell range on one sheet and change the worksheet names on another 10 sheets
to each of the names in that cell range. Can anyone offer a solution please?
Here is some code... Place this code in the sheet with the code name
"Sheet1". You just need to modify the number of items in the select statement.
The code name is the one you see in the project explorer of the Visual Basic
Editor.
Sheet1(Tab Name)
The text you enter in Cell A2 change Sheet2, A3 changes Sheet3, ...
'Code Starts************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
If Target.Column = 1 Then
If SheetExists(Target.Value) Then
MsgBox "Invalid Sheet Name", vbCritical, "Sheet Name Error"
Application.EnableEvents = False
Application.Undo
Else
Select Case Target.Row
Case 2
Sheet2.Name = Target.Value
Case 3
Sheet3.Name = Target.Value
End Select
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
Private Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function
'Code Ends****************
--
HTH...
Jim Thomlinson
"Bila" wrote:
> I have been trying unsuccessfully to find a macro that will get data from a
> cell range on one sheet and change the worksheet names on another 10 sheets
> to each of the names in that cell range. Can anyone offer a solution please?
Thanks for the very prompt reply. I seem to be missing a bit of knowledge
tho' - doesn't matter what I've tried to do with your code { a) created a
macro and pasted it in... b)Alt+F11 for VBE and Inserted Module then pasted
} Ihaven't been able to get a result.
Also, the cell range in my case is Q14:Q23 do I change the code to be
Target.Column=17 and Target.Value=???
"Bila" wrote:
> I have been trying unsuccessfully to find a macro that will get data from a
> cell range on one sheet and change the worksheet names on another 10 sheets
> to each of the names in that cell range. Can anyone offer a solution please?
Sub ChangeNames()
Dim j As Long
Dim i As Long
For j = 1 To Cells(Rows.Count, "A").End(xlUp).Row
i = i + 1
If Worksheets(i).Name <> ActiveSheet.Name Then
Worksheets(i).Name = Cells(j, "A").Value
Else
j = j - 1
End If
Next j
End Sub
put the code in a standard code module
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Bila" <Bila@discussions.microsoft.com> wrote in message
news:59C62881-1ED4-48C5-9F3B-4493A8318A52@microsoft.com...
> I have been trying unsuccessfully to find a macro that will get data from
a
> cell range on one sheet and change the worksheet names on another 10
sheets
> to each of the names in that cell range. Can anyone offer a solution
please?
Just noticed the bit about Q14:Q23, so use
Sub ChangeNames()
Dim j As Long
Dim i As Long
For j = 14 To 23
i = i + 1
If Worksheets(i).Name <> ActiveSheet.Name Then
Worksheets(i).Name = Cells(j, "Q").Value
Else
j = j - 1
End If
Next j
End Sub
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Bila" <Bila@discussions.microsoft.com> wrote in message
news:927E9C9A-F465-45B1-81E0-2AA126BC1170@microsoft.com...
> Thanks for the very prompt reply. I seem to be missing a bit of knowledge
> tho' - doesn't matter what I've tried to do with your code { a) created a
> macro and pasted it in... b)Alt+F11 for VBE and Inserted Module then
pasted
> } Ihaven't been able to get a result.
> Also, the cell range in my case is Q14:Q23 do I change the code to be
> Target.Column=17 and Target.Value=???
>
> "Bila" wrote:
>
> > I have been trying unsuccessfully to find a macro that will get data
from a
> > cell range on one sheet and change the worksheet names on another 10
sheets
> > to each of the names in that cell range. Can anyone offer a solution
please?
OK, we are getting somewhere - thankyou to both who have replied!
By somewhere, I mean that I have got the second lot of code (By Bob
Phillips) to work, BUT I am usually only changing one of the 10 names so of
course it is erroring when it tries to change the sheet to an existing
name... SO, I then attempted to intergrate both Jim & Bob's code, using the
error handling from Jims with the code I have working from Bob's - guess
what... I am STILL not that clever!
Could one of you please direct me in how to trap the error so the routine
will work its way through the rest of the names, changing the worksheet name
to any that I have altered?
Thanks, Jim Cove (Bila)
"Bob Phillips" wrote:
> Sub ChangeNames()
> Dim j As Long
> Dim i As Long
>
> For j = 1 To Cells(Rows.Count, "A").End(xlUp).Row
> i = i + 1
> If Worksheets(i).Name <> ActiveSheet.Name Then
> Worksheets(i).Name = Cells(j, "A").Value
> Else
> j = j - 1
> End If
> Next j
> End Sub
>
> put the code in a standard code module
>
>
> --
> HTH
>
> Bob Phillips
>
> (remove nothere from email address if mailing direct)
>
> "Bila" <Bila@discussions.microsoft.com> wrote in message
> news:59C62881-1ED4-48C5-9F3B-4493A8318A52@microsoft.com...
> > I have been trying unsuccessfully to find a macro that will get data from
> a
> > cell range on one sheet and change the worksheet names on another 10
> sheets
> > to each of the names in that cell range. Can anyone offer a solution
> please?
>
>
>
You could do it as worksheet change event as Jim suggests, b ut it is not
clear (at least to me) which row would pertain to which worksheet (they can
get moved around).
Simplest way is just to do this
Sub ChangeNames()
Dim oWsNext As Worksheet
Dim oWs As Worksheet
Dim iLastRow As Long
Dim j As Long
Dim i As Long
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
Set oWsNext = Nothing
On Error Resume Next
Set oWsNext = Worksheets(Cells(i, "A").Value)
On Error GoTo 0
If oWsNext Is Nothing Then
j = 1
For Each oWs In ActiveWorkbook.Worksheets
With oWs
If ActiveSheet.Name <> .Name Then
If IsError(Application.Match(.Name, _
ActiveSheet.Range("A:A"), 0)) Then
.Name = Cells(i, "A").Value
Exit For
End If
End If
End With
Next oWs
End If
Next i
End Sub
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Bila" <Bila@discussions.microsoft.com> wrote in message
news:BB6E1380-DC73-4747-9574-8EC9886947E2@microsoft.com...
> OK, we are getting somewhere - thankyou to both who have replied!
>
> By somewhere, I mean that I have got the second lot of code (By Bob
> Phillips) to work, BUT I am usually only changing one of the 10 names so
of
> course it is erroring when it tries to change the sheet to an existing
> name... SO, I then attempted to intergrate both Jim & Bob's code, using
the
> error handling from Jims with the code I have working from Bob's - guess
> what... I am STILL not that clever!
>
> Could one of you please direct me in how to trap the error so the routine
> will work its way through the rest of the names, changing the worksheet
name
> to any that I have altered?
>
> Thanks, Jim Cove (Bila)
>
> "Bob Phillips" wrote:
>
> > Sub ChangeNames()
> > Dim j As Long
> > Dim i As Long
> >
> > For j = 1 To Cells(Rows.Count, "A").End(xlUp).Row
> > i = i + 1
> > If Worksheets(i).Name <> ActiveSheet.Name Then
> > Worksheets(i).Name = Cells(j, "A").Value
> > Else
> > j = j - 1
> > End If
> > Next j
> > End Sub
> >
> > put the code in a standard code module
> >
> >
> > --
> > HTH
> >
> > Bob Phillips
> >
> > (remove nothere from email address if mailing direct)
> >
> > "Bila" <Bila@discussions.microsoft.com> wrote in message
> > news:59C62881-1ED4-48C5-9F3B-4493A8318A52@microsoft.com...
> > > I have been trying unsuccessfully to find a macro that will get data
from
> > a
> > > cell range on one sheet and change the worksheet names on another 10
> > sheets
> > > to each of the names in that cell range. Can anyone offer a solution
> > please?
> >
> >
> >
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks