Rename Sheets

[Guest]

First I want to thank everyone for their help. I've received great
assistance in this group. I have several worksheets in a work book. As it
is now, each sheet is named like Sheet1, Sheet2, and so on. Is there a way
to use vba to rename each of these sheets so that it picks up the name from
part of the text in a cell? For example, each worksheet has a specific cell
(A4) that includes "Business: XYZ Company". I want to name the sheet with
what is in cell A4 minus the "Business: " leaving only XYZ Company. The
second part of this is that there are so many sheets that it would be nice to
have vba prompt with an InputBox for a company name and then find that sheet
with the same name entered into the InputBox, display it, and then
automatically print it. I've tried several different methods to accomplish
both but haven't had any luck. Thanks.

 

[Bob Phillips]

Hi Kevin,

First part

Dim sh As Worksheet

For Each sh In ActiveWorkbook.Worksheets
sh.Name = Replace(sh.Range("A4").Value, "Business ", "")
Next sh

Second part, an alternative suggestion, let them select from this dialog

Sub PrintSheets()
Const nPerColumn As Long = 35 'number of items per­­ column
Const nWidth As Long = 7 'width of each lette­­r
Const nHeight As Long = 18 'height of each row
Const sID As String = "___WorksheetPrint" 'name of dialog­ shee­t
Const kCaption As String = " Select worksheets to print"
'dialog caption


Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cLeft As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox


Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If


On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add


With thisDlg


.Name = sID
.Visible = xlSheetHidden


'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40


For i = 1 To ActiveWorkbook.Worksheets.Count


If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If


Set CurrentSheet = ActiveWorkbook.ActiveSheet
cLetters = Len(ActiveWorkbook.Worksheets(i).Name­)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If


iBooks = iBooks + 1
.CheckBoxes.Add cLeft, TopPos, cLetters * nWidth­, 16.5
.CheckBoxes(iBooks).Caption = ActiveWorkbook.Wor­ksheets(i).Name
TopPos = TopPos + 13


Next i


.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24


CurrentSheet.Activate


With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeigh­t + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With


.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront


Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).Pr­intOut
End If
Next cb
Else
MsgBox "No sheets selected"
End If
Application.DisplayAlerts = False


.Delete


End With


End Sub





--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Ken Wright]

Hi Bob, think you missed off the colon after Business

sh.Name = Replace(sh.Range("A4").Value, "Business: ", "")

 

[Bob Phillips]

Hi Ken,

I didn't even see it . Time to get those glasses!

Bob

 

[Guest]

First part worked great! Second part worked to a degree but... there are too
many check boxes that show up so they all don't fit in the window and some
are pre-checked for some reason. I really like this check box idea, any
other way to get around this? Maybe make it so that it scrolls down a list
and I can check off or some other method? Thanks for all the help.

 

[Bob Phillips]

Kevin,

A scrollbar would be nice but I don't think this can be done. Here is an
alternative version that fits to size. It is columnar. I have set it to 35
per column, but you can change this, and tune it.

Sub PrintSheets()
Const nPerColumn As Long = 35 'number of items per­ column
Const nWidth As Long = 7 'width of each lette­r
Const nHeight As Long = 14 'height of each row
Const sID As String = "___SheetPrint" 'name of dialog shee­t
Const kCaption As String = " Select sheets to print"
'dialog caption


Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox

Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40

For i = 1 To ActiveWorkbook.Worksheets.Count

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.CheckBoxes.Add cLeft, TopPos, cLetters * nWidth, 16.5
.CheckBoxes(iBooks).Text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).PrintOut
End If
Next cb
Else
MsgBox "Nothing Selected"
End If
Application.DisplayAlerts = False

.Delete

End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Guest]

Still no luck, getting pretty much the same results. 350 sheets I guess are
just too many for it to handle. How about a way to create a dialog box that
generates a drop down list of all the sheet names? Then I could select the
name from the list and click Print or Cancel to exit out? Thanks for the
assist.

 

[Bob Phillips]

You guys are so demanding

What are you doing with 350 sheets, that must be unmanageable. Anyway,
here's another shot

Sub PrintSheets()
Const nPerColumn As Long = 35 'number of items per­ column
Const nWidth As Long = 7 'width of each lette­r
Const nHeight As Long = 14 'height of each row
Const sID As String = "___SheetPrint" 'name of dialog shee­t
Const kCaption As String = " Select sheets to print"
'dialog caption


Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As DropDown

Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.Name = sID
.Visible = xlSheetHidden

iBooks = 0

.ListBoxes.Add 78, 40, 148, 120
.ListBoxes(1).Name = sID
.ListBoxes(sID).MultiSelect = xlExtended

For i = 1 To ActiveWorkbook.Worksheets.Count

Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.ListBoxes(sID).AddItem _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = 242

CurrentSheet.Activate

With .DialogFrame
.Height = 160
.Width = 260
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For i = 1 To thisDlg.ListBoxes(1).ListCount
If .ListBoxes(sID).Selected(i) Then

ActiveWorkbook.Worksheets(.ListBoxes(sID).List(i)).PrintOut
End If
Next i
Else
MsgBox "Nothing Selected"
End If
Application.DisplayAlerts = False

.Delete

End With

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Tom Ogilvy]

Just create a userform and put a combobox on it.

in the initialize event, you can populate it with

for each sh in thisworkbook.worksheets
combobox1.AddItem sh.Name
Next

then put on a button labelled print. Name it Cmd_Print_Click()

Private Sub Cmd_Print_Click()
worksheets(combobox1.value).Printout
End Sub


And you can add a cancel button as well.

 

[Guest]

Thanks Bob for hanging in there with me. That worked like a charm. What can
I say, you're a genius!

 

[Ken Wright]

LOL - Think I'm headed that way as well

 

[Ken Wright]

Just as an aside, an easier way to navigate through worksheets is to right
click on the arrows at the bottom left of your sheet. Click on the 'More
sheets' bit and you will have a scrollable list that is much easier than
scrolling left/right.

 

[Bob Phillips]

Ken,

It's not to navigate through them, it's to print the selected sheets. It's
been such a long thread, only Kevin and I remember the original objective


Bob

 

[Ken Wright]

LOL - I hadn't missed it honest Bob, hence my comment about it being an
aside. I'm just guessing that if the OP has that many sheets that it is a
pain to get to to print, then it is likely to be just as much of a pain to
navigate.

 

[Bob Phillips]

To be honest Ken, if the OP has that many sheets, IMO it's time for an
application re-design.

Bob

LOL - I hadn't missed it honest Bob, hence my comment about it being an
aside. I'm just guessing that if the OP has that many sheets that it is a
pain to get to to print, then it is likely to be just as much of a pain to
navigate.

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

-------------------------------------------------------------------------- --
It's easier to beg forgiveness than ask permission
-------------------------------------------------------------------------- --

Ken,

It's not to navigate through them, it's to print the selected sheets. It's
been such a long thread, only Kevin and I remember the original objective


Bob

Just as an aside, an easier way to navigate through worksheets is to right
click on the arrows at the bottom left of your sheet. Click on the 'More
sheets' bit and you will have a scrollable list that is much easier than
scrolling left/right.

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

--------------------------------------------------------------------------

--------------------------------------------------------------------------

--

First I want to thank everyone for their help. I've received great
assistance in this group. I have several worksheets in a work book. As
it
is now, each sheet is named like Sheet1, Sheet2, and so on. Is

there

a sheet
with be
nice

 

[Ken Wright]

No argument there - Pivottttttttttttttttttttttttt