Guys I'm delighted with the result. I runthe following code as part of
another module and it works as I like, apart for one issue. When I run
it, the Microsoft Visual Basic project window remains open, why is that
and how can I close it?

Sub Populate_TW()
Dim StartLine As Long
Dim msg1 As String, msg2 As String


msg1 = "Dim sh As Worksheet" & vbCr & _
"With Application" & vbCr & _
"If .UserName = ""John"" Or .UserName = ""Joe"" Or .UserName =
""Johnny"" Then"


msg2 = "ThisWorkbook.Sheets(""E-Mail"").Select" & vbCr & _
"Else" & vbCr & _
"ThisWorkbook.Sheets(""E-Blank"").Select" & vbCr & _
"MsgBox ""You are NOT Permitted to access this File "" & vbCr & _" &
vbCr & _
""""" & vbCr & _" & vbCr & _
"""Please Contact Joe Bloggs at "" & vbCr & _" & vbCr & _
""""" & vbCr & _" & vbCr & _
"""ABC Group +0019 69944000""" & vbCr & _
"ThisWorkbook.Sheets(""E-Mail"").Select" & vbCr & _
"Application.DisplayAlerts = False" & vbCr & _
"ThisWorkbook.Close False" & vbCr & _
"End If" & vbCr & _
"End With"


With ActiveWorkbook.VBProject.VBComponents("ThisWorkboo k").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
..InsertLines StartLine, msg1 & vbCr & msg2
End With
End Sub







Sean wrote:

Thanks Guys. I wasn't aware that there was a limit on the continuation
lines, how many is it?


Greg Wilson wrote:

I took some liberty with your code and made a few changes. The main problems
were that quoted text withing quotes must have double quotes. Also, you had
too many line continuations which raised an error. I split it up into two
strings to avoid this. Very little testing.

Sub Populate_TW()
Dim StartLine As Long
Dim msg1 As String, msg2 As String

msg1 = "Dim sh As Worksheet" & vbCr & _
"Dim myArray As Variant" & vbCr & _
"Application.ScreenUpdating = False" & vbCr & _
"For Each sh In ThisWorkbook.Worksheets" & vbCr & _
"sh.Select" & vbCr & _
"Application.GoTo Reference:=sh.Range(""a1""), Scroll:=True" & vbCr & _
"Next sh" & vbCr & _
"ThisWorkbook.Sheets(""Input"").Select" & vbCr & _
"Application.ScreenUpdating = True" & vbCr & _
"myArray = Range(""Users"").Value"

msg2 = "With Application" & vbCr & _
"If IsError(.Match(.UserName, myArray, 0)) Then" & vbCr & _
"ThisWorkbook.Sheets(""Blank Sheet"").Select" & vbCr & _
"MsgBox ""You are NOT Permitted to access this File "" & vbCr & _" & vbCr & _
"""Please Contact Joe Bloggs at "" & vbCr & _" & vbCr & _
"""ABCGroup +0019 69944000""" & vbCr & _
"ThisWorkbook.Sheets(""Input"").Select" & vbCr & _
"Application.DisplayAlerts = False" & vbCr & _
"ThisWorkbook.Close False" & vbCr & _
"End If" & vbCr & _
"End With"

With ActiveWorkbook.VBProject.VBComponents("ThisWorkboo k").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
.InsertLines StartLine, msg1 & vbCr & msg2
End With
End Sub

Regards,
Greg