Generating sheets using several templates

[jondallimore]

Hello,

I have the code below, which generates a set of worksheets from a list of dates using a template sheet.

However, I am looking to edit it... to do this:

1) select the right template to use based on the day in column E, and the week number in column G.

I.e. - 01.09.14 is a Monday of week 1, so that worksheet should be called 01.09.14 - which is already happening - and should be a copy of "Monday 1" template sheet.

2) there will be template sheets named Monday 1, tuesday 1, wednesday 1 , thursday 1, friday 1
AND the corresponding templates for week 2.

How can I make this code select the right template to use based on the values in columns E and G?

Thanks in advance for any help.
Jon

PS, I thought it better to put the entire code in... apologies for the long post.



Private Sub CommandButton1_Click()
Dim cell As Range, rnglist As Range
Dim ws As Worksheet
Set rnglist = Range("A3", Range("A" & Rows.Count).End(xlUp))
Set rngday = Range("E3", Range("E" & Rows.Count).End(xlUp))
Set rngweek = Range("G3", Range("G" & Rows.Count).End(xlUp))

If Sheet2.Cells(3, 1) = "" Then
Sheet2.Activate
Cells(3, 1).Select
Application.DisplayAlerts = False
For Each ws In Worksheets
'Keep these non-list sheets
If InStr("|Navigation|Template|Instructions|", "|" & ws.name & "|") = 0 Then
'Test if each sheet is on the list
If WorksheetFunction.CountIf(rnglist, ws.name) = 0 Then ws.Delete
End If
Next ws
Application.DisplayAlerts = True
GoTo Skipout
Else:
GoTo Doit
End If
Doit:
Application.ScreenUpdating = False
For Each cell In rnglist
If cell.Value <> "" Then
On Error Resume Next
'test if worksheet exists
If Len(Worksheets(cell.Value).name) = 0 Then
On Error GoTo 0
'copy worksheet named "Template"
Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.name = cell.Value 'name new sheet
'Create hyperlink
Let x = "'" & cell.Value & "'!A1"
cell.Parent.hyperlinks.Add Anchor:=cell, _
Address:="", _
SubAddress:=x, _
TextToDisplay:=cell.Value

End If
On Error GoTo 0
End If
Next cell
CommandButton1.Parent.Activate 'go back to the source worksheet
'Delete "Other" Sheets not on the list
Application.DisplayAlerts = False
For Each ws In Worksheets
'Keep these non-list sheets
If InStr("|Navigation|Template|Instructions|", "|" & ws.name & "|") = 0 Then
'Test if each sheet is on the list
If WorksheetFunction.CountIf(rnglist, ws.name) = 0 Then ws.Delete
End If
Next ws
Application.DisplayAlerts = True
'FormulaeGeneration:
'With Worksheets("Navigation").Range("C2:XFD2")
' .Cells.AutoFill Destination:=.Cells.Resize(rnglist.Count + 1)
'End With
'Formatting:
'clear all previous borders in columns A and B
With Range("A:B")
.borders(xlDiagonalDown).LineStyle = xlNone
.borders(xlDiagonalUp).LineStyle = xlNone
.borders(xlEdgeLeft).LineStyle = xlNone
.borders(xlEdgeTop).LineStyle = xlNone
.borders(xlEdgeBottom).LineStyle = xlNone
.borders(xlEdgeRight).LineStyle = xlNone
.borders(xlInsideVertical).LineStyle = xlNone
.borders(xlInsideHorizontal).LineStyle = xlNone
End With
'Add borders
With rnglist.Resize(, 2) 'list columns A and B
.borders(xlEdgeLeft).Weight = xlMedium
.borders(xlEdgeTop).Weight = xlMedium
.borders(xlEdgeBottom).Weight = xlMedium
.borders(xlEdgeRight).Weight = xlMedium
.borders(xlInsideVertical).Weight = xlThin
.borders(xlInsideHorizontal).Weight = xlThin
End With
Skipout:
Range("A2").Select
Selection.borders(xlDiagonalDown).LineStyle = xlNone
Selection.borders(xlDiagonalUp).LineStyle = xlNone
With Selection.borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.borders(xlInsideVertical).LineStyle = xlNone
Selection.borders(xlInsideHorizontal).LineStyle = xlNone
Range("B2").Select
Selection.borders(xlDiagonalDown).LineStyle = xlNone
Selection.borders(xlDiagonalUp).LineStyle = xlNone
With Selection.borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.borders(xlInsideVertical).LineStyle = xlNone
Selection.borders(xlInsideHorizontal).LineStyle = xlNone
Range("A3").Select


On Error Resume Next
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0


If Sheet2.Cells(3, 1) = "" Then
MsgBox "You must enter Student Names in Column A"
End If
Application.ScreenUpdating = True

Break:
Application.ScreenUpdating = True
End Sub








Private Sub CommandButton2_Click()


Dim SNarray() As Variant
Dim i As Long
Dim s As Worksheet


i = 0


For Each s In ThisWorkbook.Sheets
Select Case s.name
Case Is = "Navigation", "Template"
'do nothing
Case Else
ReDim Preserve SNarray(i)
SNarray(i) = s.name
Debug.Print SNarray(i)
i = i + 1
End Select
Next
Dim arrSheets, sh As Worksheet
arrSheets = SNarray
If i = 0 Then
GoTo Ending
Else
Application.ScreenUpdating = False
Sheets(arrSheets).Select
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
sh.PageSetup.PrintArea = ""
With sh.PageSetup
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next sh
Sheets(arrSheets).PrintPreview False
End If
GoTo Skippy
Ending:
MsgBox "There are no Marksheets to print"
Skippy:
Sheets("Navigation").Activate
Application.ScreenUpdating = True

End Sub

[SamT]

I am glad that you re using Excel 2007 or newer,because that is over Excel XP's limits.

In any case, 260 template sheets is ridiculous when the only difference is the day of the week and the week of the year. Study the differences in the template, make one basic template, then use code to make the template copy conform to weekday and week #.

As to the code you posted above, there are so many errors, redundancies, and extraneous stuff in it, I won't discuss it.

First thing to do is place "Option Explicit" (without quotes) at the top of the Code page.
Then Using the VBA ToolBar menu, Tools >> Options >> Editor Tab, check all the checkboxes in the "Code Settings Frame.
Finally, click the Debug Menu >> Compile VBA Project and correct any errors found. Repeat until the Project Compiles without error.

Please get back to us when you have successfully compiled the Project, so we can help you find the final errors which won't show up until you run the Form.

BTW, your InStr function as used above in the first sub will always return 0.

[jondallimore]

Right.
well theres 10 template sheets, not 260. The whole point of using 10 different templates is that the templates are all different, but they get repeated once a fortnight throughout the year. I'm not sure where you got 260 templates from.

The code above works. It may have extraneous stuff and redundancies, but it works. Why would I bother reinventing the wheel when its already rolling?

If anyone can help modify the code, rather than criticise it, please reply.

[SamT]

I'm not sure where you got 260 templates from.... If anyone can help modify the code, rather than criticise it, please reply.If anyone can help modify the code, rather than criticise it, please reply. Well, that leaves me out

[jondallimore]

clearly.

Does anyone have any positive suggestions?

[Aussiebear]

Yes I do. However I'm curious as to why you are not looking to improve your current code? You say it works but it doesn't want to compile correctly. Are you able to attach a workbook for us to test it? If so, please go to Go Advanced, Manage Attachments and follow the prompts from there.

[jondallimore]

Why would I mess with something that works? It would be like trying to tune a car engine that is already running well. It might result in some efficiencies, but it might also result in the engine falling to bits.

The sheet is attached - its a little messy at the moment, but if the sheet generation code can be made to work then I'll tidy it up. Feel free to do whatever you need to with it!

At the moment, I only have 1 template sheet on there... The 10 template sheets I would need will be called:

Monday1
Tuesday1
Wednesday1
Thursday1
Friday1

Monday2
Tuesday2
Wednesday2
Thursday2
Friday2

Thanks in advance for any help.

[GTO]

Why would I mess with something that works?

Because going to the moon seems neater than being the 13 bajionth guy to get across a field airborne. Getting across the field airborne in a heavier-than-air aircraft was neat, but WOW, the Moon!


It would be like trying to tune a car engine that is already running well.

If that were true, you would not have posted a question.


It might result in some efficiencies,...

Yep


...but it might also result in the engine falling to bits.

A teensy bit doubtful, but trying to be sensitive, always possible. It's typing keystrokes and a fairly hardy OS and app; hopefully the next generation of humans doesn't die screaming and on fire...


Does anyone have any positive suggestions?

I am damn near positive you would get better help upon realizing that any help is given for free and from good-will, or at worst, as a handy way of 'target-practice' (keeping one's skills) for the helper.

...just sayin'....

Mark

[jondallimore]

Maybe you shouldnt "just say".

Nothing you have said is useful, but instead just designed to rile someone.

If anyone has anything useful to say, from their goodwill, then please do.

If anyone just wants to criticise, then please dont bother.

I am quite capable of thanking people for their help without being told to do so by you Mark.

[Aussiebear]

In an effort to get this thread back on the rails, let's leave the emotion somewhere else.

1. The number of templates.
If the 10 templates are repeated every 2 weeks, it's a reasonable assumption of simple mathematics to determine (52/2)*10 to arrive at 260 templates. If this was my project, I'd only use one template, to display, record, edit and or save the data.

2. Option Explicit.
One of the best practices, with coding is the habit of using Option Explicit at the top of any code. it would be one of the best error trapping functions available within vba and is being highly recommended in this section of submitted code.

3. VBAEXPRESS.com
This website is dedicated to the promotion of VBA, by encouraging all participants to, not just use VBA but more importantly to gain a better understanding of the language and the methods of application. There are a number of alternative sites which may simply provide snippets of code to assist.

At this point, active members are clearly indicating that the initial section of submitted code has a number of errors which need to be corrected before we can move on to adjusting the code to fulfil your request. My guess is that if you don't wish to do this then, this thread is doomed to fail, for there is little to be gained from a thread being flamed.

Jon, I'm not sure that being adamant about not wanting improve the structure and logic of a section of code, giving that you are asking for assistance, is a good way forward. However it a decision to only you can make. Those that want to contribute to your thread, may be reluctant to do so given the posts. Please feel free to PM me about your intentions, but be aware that I'm leading towards closing this thread rather than allow this matter become further inflamed.