Select sheets ina workbook based on radio buttons and move them

L

Larry Fitch

I am lookig for a way to have a user select only the sheets required by
selecting radio buttons that pertain to the required sheets and once selcted,
a button that would allow these sheets to be copied into a new workbook..
 
D

Don Guillett

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You send a clear explanation of what you want
3. You send before/after examples and expected results.
 
L

Larry Fitch

so - the worksheets are the intellectual property of my company and I am not
at liberty to send them along...

If you require them to answer my question (and I don't know why you would) I
will have to pass.. sorry...
--
Thanks

Larry


Don Guillett said:
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You send a clear explanation of what you want
3. You send before/after examples and expected results.
 
D

Dave Peterson

How about a generic utility addin that provides this functionality.

If that's ok...

Start a new workbook (no sheets will be used).
Got into the VBE and put this code into a general module:

Option Explicit
Public Const ToolBarName As String = "Larry's Utilities"
Sub Auto_Open()
Call CreateMenubar
End Sub
Sub Auto_Close()
Call RemoveMenubar
End Sub
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("ShowTheForm")

CapNames = Array("Select The Sheets To Copy")

TipText = Array("Make sure the correct workbook is active!")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNames(iCtr)
.Style = msoButtonIconAndCaption
.FaceId = 71 + iCtr
.TooltipText = TipText(iCtr)
End With
Next iCtr

End With
End Sub
Sub ShowTheForm()
UserForm1.Show
End Sub

Then create a userform with a single listbox (to hold the names of the sheets)
and 2 commandbuttons.

Use the names Listbox1 and commandbutton1 and commandbutton2.

The put this code behind the userform:

Option Explicit
Private Sub CommandButton1_Click()
'cancel button
Unload Me
End Sub
Private Sub CommandButton2_Click()
'ok button
Dim iCtr As Long
Dim sCtr As Long
Dim myArr() As String

ReDim myArr(1 To ActiveWorkbook.Sheets.Count)
sCtr = 0
With Me.ListBox1
For iCtr = 0 To Me.ListBox1.ListCount - 1
If .Selected(iCtr) = True Then
sCtr = sCtr + 1
myArr(sCtr) = .List(iCtr)
End If
Next iCtr
End With

If sCtr = 0 Then
'shouldn't happen
Beep
Else
ReDim Preserve myArr(1 To sCtr)
ActiveWorkbook.Sheets(myArr).Copy 'to a new workbook
End If

Unload Me '???

End Sub

Private Sub ListBox1_Change()

Dim iCtr As Long

Me.CommandButton2.Enabled = False

With Me.ListBox1
For iCtr = 0 To .ListCount - 1
If .Selected(iCtr) = True Then
Me.CommandButton2.Enabled = True
Exit For
End If
Next iCtr
End With

End Sub
Private Sub UserForm_Initialize()
Dim sh As Object

With Me.CommandButton1
.Caption = "Cancel"
.Cancel = True
.Enabled = True
End With

With Me.CommandButton2
.Caption = "Ok"
.Default = True
.Enabled = False
End With

With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption

For Each sh In ActiveWorkbook.Sheets
If sh.Visible = xlSheetVisible Then
.AddItem sh.Name
End If
Next sh
End With
End Sub

=========
Now back to excel and do a File|SaveAs. Save this new workbook as an addin with
a nice name "LarryUtils.xla" and save it into your favorite folder.

Now close excel and reopen it.

In xl2003 menus, use:
Tools|addins
and browse to that folder and click on your addin.

You should see a new toolbar.

Add a few sheets to a test workbook and click that button.

======
(Saved from a previous post)

For additions to the worksheet menu bar, I really like the way John Walkenbach
does it in his menumaker workbook:
http://j-walk.com/ss/excel/tips/tip53.htm

Here's how I do it when I want a toolbar:
http://www.contextures.com/xlToolbar02.html
(from Debra Dalgleish's site)

In xl2007, those toolbars and menu modifications will show up under the addins.

And if you use xl2007:

If you want to learn about modifying the ribbon, you can start at Ron de Bruin's
site:
http://www.rondebruin.nl/ribbon.htm
http://www.rondebruin.nl/qat.htm -- For macros for all workbooks (saved as an
addin)
or
http://www.rondebruin.nl/2007addin.htm

=============
If you've never created a userform...

Debra Dalgleish has some nice notes about userforms:
http://contextures.com/xlUserForm01.html
(video: http://contextures.com/xlVideos05.html#UserForm01)
and
http://contextures.com/xlUserForm02.html

===========
If you have to support others who need the same thing, just share the .xla file
and tell them to save it to a nice folder and then tell them how to use
Tools|Addins to install it.

You may find that you'll develop other generic utilities that you want to share
with others. Just keep adding them to your toolbar (or menubar) and you'll be
set.
 
D

Dave Peterson

I think changing the location of one line would make it better:

If sCtr = 0 Then
'shouldn't happen
Beep
Else
ReDim Preserve myArr(1 To sCtr)
ActiveWorkbook.Sheets(myArr).Copy 'to a new workbook
End If

Unload Me '???

==========
The "unload me" line should be moved inside the Else portion of that
if/then/else statement.

If sCtr = 0 Then
'shouldn't happen
Beep
Else
ReDim Preserve myArr(1 To sCtr)
ActiveWorkbook.Sheets(myArr).Copy 'to a new workbook
Unload Me '???
End If
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top