Print array based on menu choice

D

David

I know how to add a custom menu and populate it with items from an array
list and perform an .OnAction based on menu item clicked. Right now I
have this in Personal.xls:

Private Sub OpenTheFile()
With Application.CommandBars.ActionControl
Workbooks.Open "C:\DATA\EXCEL\" & .Caption
End With
End Sub

This one doesn't get run until I want a different list.
Private Sub AddMenu()
Dim vFile, vFiles
vFiles = Array("MyCheckBook", "DT Biweekly Timesheet", "Foodcost",
"Who_Ate", "GFS Inventory", "Attendance Stats", "TimeSheet", "Class
Utilization", "Class Signups", "Unit Signups")
With Application.CommandBars("Worksheet Menu Bar")
With .Controls.Add(msoControlPopup, before:=2, temporary:=False)
..Caption = "D&aily Files"
For Each vFile In vFiles
With .Controls.Add(msoControlButton)
..Caption = vFile
..OnAction = "OpenTheFile"
End With
Next
End With
End With
End Sub

I plan to populate my new workbook's custom menu with
vDay = array("Monday","Tuesday","Wednesday","Thursday")

What I want to do is print sheets where A1's value will call a sub() and
loop through an array of 6 classes based on the day I choose from that
custom menu. Example:

MonArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
TueArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
WedArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
ThuArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")

I will, of course, replace ClassX with actual class names

Here's what I do now, with sheet code:

Private Sub Worksheet_Change(ByVal Target As Range)
' Here's where I want the day's array of 6 classes to go
If Target.Address = "$A$1" Then
Select Case Target.Value
Case "Beginning Computer", "Intermediate Computer", "Adult Basic
Education", "Creative Writing"
Range("A14:A20").EntireRow.Hidden = True
Range("E11").Value = 4
Case Else
ActiveSheet.Rows.Hidden = False
Range("E11").Value = 11
End Select
Range("H2").Value = Date
ActiveSheet.UsedRange
ActiveSheet.PrintOut
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
ActiveWindow.Zoom = 100
Else
ActiveWindow.Zoom = 55
End If
End Sub

User selects a class from data valadation list in A1 and a sheet for that
class is printed. User repeats for each desired class

What I want to do is print sheets where A1's value will loop through an
array of 6 classes based on the day I choose from my custom menu Example:

MonArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
TueArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
WedArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
ThuArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")

I will, of course, replace ClassX with actual class names
Class names vary each day, but are static for that day

I hope I haven't provided too much or too little info to describe my
needs.
 
T

Tom Ogilvy

Private Sub Worksheet_Change(ByVal Target As Range)
' Here's where I want the day's array of 6 classes to go
Dim MonArr, TueArr, WedArr, ThuArr, v
MonArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
TueArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
WedArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
ThuArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")

If Target.Address = "$A$1" Then
Select Case Target.Value
Case "Monday"
v = MonArr
Case "Tuesday"
v = TueArr
Case "Wednesday"
v = WedArr
Case "Thursday"
v = ThuArray
End select
for i = lbound(v) to ubound(v)
Worksheets(v(i)).Activate
Select Case v(i)
Case "Beginning Computer", "Intermediate Computer", "Adult Basic
Education", "Creative Writing"
Range("A14:A20").EntireRow.Hidden = True
Range("E11").Value = 4
Case Else
ActiveSheet.Rows.Hidden = False
Range("E11").Value = 11
End Select
Range("H2").Value = Date
ActiveSheet.UsedRange
ActiveSheet.PrintOut
Next i
"End Sub
 
D

David

Tom Ogilvy wrote
Private Sub Worksheet_Change(ByVal Target As Range)
' Here's where I want the day's array of 6 classes to go
Dim MonArr, TueArr, WedArr, ThuArr, v
MonArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
TueArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
WedArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")
ThuArr = Array("Class1","Class2","Class3","Class4","Class5","Class6")

If Target.Address = "$A$1" Then
Select Case Target.Value
Case "Monday"
v = MonArr
Case "Tuesday"
v = TueArr
Case "Wednesday"
v = WedArr
Case "Thursday"
v = ThuArray
End select
for i = lbound(v) to ubound(v)
Worksheets(v(i)).Activate
Select Case v(i)
Case "Beginning Computer", "Intermediate Computer", "Adult Basic
Education", "Creative Writing"
Range("A14:A20").EntireRow.Hidden = True
Range("E11").Value = 4
Case Else
ActiveSheet.Rows.Hidden = False
Range("E11").Value = 11
End Select
Range("H2").Value = Date
ActiveSheet.UsedRange
ActiveSheet.PrintOut
Next i
"End Sub
Click to expand...

Tom, thanks for your effort, but...

Guess I didn't explain clearly enough. I want Workbook_Activate to build
my menu with Monday, Tuesday, Wednesday, Thursday. I can do that. Then
when I click on a day, execute the Change event after my choice ends up
in A1, then looping then through the class names in the relevant array,
triggering the printout of a sheet for each class in that array.

BTW, there is only one sheet to the workbook and $A$1 is where the class
name ends up (presently via Data Validation dropdown)

I did try to adapt your code anyway, but it always bombed at line 1 or 2
of the Lbound(v) to Ubound(v) loop
Instead of Worksheets(v(i)).Activate, I substituted
Range("A1").Text = (v(i)) -- also tried v(i) -- same result as below
Then I typed Monday in A1 (that's where the day from the menu choice
would go, I'm guessing) just to see what would happen, and I got
"Runtime error '424': Object required" with that line highlighted when I
clicked Debug
At first I used .Value, but it bombed with 'Type Mismatch' when it hit
For i = LBound(v) To UBound(v)

I can sense we're close, but no cigar yet
 
D

David

Tom Ogilvy wrote
Private Sub Worksheet_Change(ByVal Target As Range)
Click to expand...

Further test:
Changed
For i = LBound(v) To UBound(v)
Range("A1") = (v(i)).Text
Select Case v(i)

to

For i = LBound(v) To UBound(v)
Range("A1") = (v(i))
Select Case v(i)

And at least got the first class name in the array to show in A1
 
D

David

Tom Ogilvy wrote
Private Sub Worksheet_Change(ByVal Target As Range)
Click to expand...

Ok, how 'bout this for now:
User types desired day name in A1, will play with Menu later

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
test
End Sub

Sub test()
Dim MonArr, TueArr, WedArr, ThuArr, v, i As Long
On Error GoTo Quit '<-- Resume Next loops endlessly at 6th class
'If left out, Type Mismatch same place as before
MonArr = Array("Intermediate Computer", "Wellness", "Supported
Employment", "Understanding Your Medications", "Creative Writing",
"Picking Up The Pieces")
TueArr = Array("LIFTT", "Wellness", "WRAP", "Sign Language", "Beginning
Computer", "Anger Management")
WedArr = Array("Intermediate Computer", "Wellness", "Supported
Employment", "Understanding Your Symptoms", "WRAP", "Anger Management")
ThuArr = Array("Picking Up The Pieces", "Wellness", "LIFTT", "Adult Basic
Education", "Beginning Computer", "Creative Writing")
Range("H2").Value = Date
Select Case Range("A1").Value '<-- Changed from Select Case v(i)
Case "Monday"
v = MonArr
Case "Tuesday"
v = TueArr
Case "Wednesday"
v = WedArr
Case "Thursday"
v = ThuArr
End Select
For i = LBound(v) To UBound(v)
Range("A1") = (v(i))
Select Case v(i)
Case "Beginning Computer", "Intermediate Computer", "Adult Basic
Education", "Creative Writing"
Range("A14:A20").EntireRow.Hidden = True
Range("E11").Value = 4
Case Else
ActiveSheet.Rows.Hidden = False
Range("E11").Value = 11
End Select
ActiveSheet.UsedRange
ActiveSheet.PrintPreview '<-- will change to .PrintOut
Next i
Quit:
End Sub

Worked in my limited tests anyway
 
D

David

David wrote
Ok, how 'bout this for now
Click to expand...

Works if I put code from test() in Worksheet_Change, too, eliminating need
for Module.

Then I can change Select Case Range("A1").Value back to
Select Case Target.Value
 
D

David

In case anyone's interested, here's the final product

Private Sub Workbook_Activate()
On Error Resume Next
Application.CommandBars(1).Controls("Signups").Delete
Dim vDay, vDays
vDays = Array("Monday", "Tuesday", "Wednesday", "Thursday")
With Application.CommandBars("Worksheet Menu Bar")
With .Controls.Add(msoControlPopup)
..Caption = "Signups"
..BeginGroup = True
For Each vDay In vDays
With .Controls.Add(msoControlButton)
..Caption = vDay
..OnAction = "PrintToday"
End With
Next
End With
End With
End Sub

Private Sub Workbook_Deactivate()
On Error Resume Next
Application.CommandBars(1).Controls("Signups").Delete
End Sub

Private Sub PrintToday()
With Application.CommandBars.ActionControl
Range("A1") = .Caption
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
On Error GoTo Quit
Dim MonArr, TueArr, WedArr, ThuArr, v, i As Long
MonArr = Array("Intermediate Computer", "Wellness", "Supported
Employment", "Understanding Your Medications", "Creative Writing",
"Picking Up The Pieces")
TueArr = Array("LIFTT", "Wellness", "WRAP", "Sign Language", "Beginning
Computer", "Anger Management")
WedArr = Array("Intermediate Computer", "Wellness", "Supported
Employment", "Understanding Your Symptoms", "WRAP", "Anger Management")
ThuArr = Array("Picking Up The Pieces", "Wellness", "LIFTT", "Adult Basic
Education", "Beginning Computer", "Creative Writing")
Select Case Target.Value
Case "Monday"
v = MonArr
Case "Tuesday"
v = TueArr
Case "Wednesday"
v = WedArr
Case "Thursday"
v = ThuArr
End Select
For i = LBound(v) To UBound(v)
Range("A1") = (v(i))
Select Case v(i)
Case "Beginning Computer", "Intermediate Computer", "Adult Basic
Education", "Creative Writing", "Sign Language"
Range("A14:A20").EntireRow.Hidden = True
Range("E11").Value = 4
Case Else
ActiveSheet.Rows.Hidden = False
Range("E11").Value = 11
End Select
ActiveSheet.UsedRange
ActiveSheet.PrintOut
Next i
Quit:
End Sub

Thanks again, Tom Ogilvy, for leading the way
 

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

Similar Threads

Crosstab or not? 1
loop through table columns 4
Why Type Mismatch error 5
Array code only works on selected sheet 14
Suppress 'Printing page' popup 4
Combobox items based on choice in previous combobox 0
Disable custom menu item based on visible cells 1
Combobox list based on choice in previous combobox 0

Top