I am trying to insert via code, code into ThisWorkbook. I have read
Chip Pearson site and seen some examples by Bob Phillips which I am
trying to replicate without much look. I returns a syntax error. I am
aware of the Trusted VBA and Reference to Microsoft VBA Extensibility.
The code I am running is as follows. Could anyone assist?




Sub Populate_TW()

Dim StartLine As Long

With
ActiveWorkbook.VBProject.VBComponents("ThisWorkboo k").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
.InsertLines StartLine, _
"Application.ScreenUpdating = False"& vbCrLf & _
"Dim sh As Worksheet"& vbCrLf & _
"For Each sh In ThisWorkbook.Worksheets"& vbCrLf & _
"sh.Select"& vbCrLf & _
"Application.GoTo Reference:=sh.Range("a1"), Scroll:=True"& vbCrLf &
_
"Next sh"& vbCrLf & _
"ThisWorkbook.Sheets("Input").Select"& vbCrLf & _
"Application.ScreenUpdating = True"& vbCrLf & _
"Dim myArray As Variant"& vbCrLf & _
"Dim arName As String"& vbCrLf & _
"arName = "Users""& vbCrLf & _
"myArray = ThisWorkbook.Names(arName).RefersToRange.Value"& vbCrLf & _
"With Application"& vbCrLf & _
"If IsError(.Match(.UserName, myArray, 0)) Then"& vbCrLf & _
"ThisWorkbook.Sheets("Blank Sheet").Select"& vbCrLf &_
"MsgBox "You are NOT Permitted to access this File " & vbNewLine & _"&
vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""Please Contact " & vbNewLine & _"& vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""Joe Bloggs at " & vbNewLine & _"& vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""ABCGroup +0019 69944000""& vbCrLf & _
"Application.DisplayAlerts = False"& vbCrLf & _
"ThisWorkbook.Close False"& vbCrLf & _
"Else"& vbCrLf & _
"End If"& vbCrLf & _
"End With"& vbCrLf & _
"ThisWorkbook.Sheets("Input").Select"
End Sub

Sean,

You've got too many line continuations and you haven't properly used quotes.
Rather than trying to build the entire event procedure code with so many
line continuations, you'll find it MUCH easier to create and maintains the
code if you build it up line by line. E.g.,

Dim S As String
S = "first line" & vbCrLf
S = S & "next line" & vbCrLf
S = S & "another line" & vbCrLf
' and so on

This will make life MUCH simpler.

Also, you're not using quotes properly. To include a quote mark within the
string, you must use two quote characters. E.g.,

Dim S As String
S = "This ""word"" is quoted."
Debug.Print S


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
I am trying to insert via code, code into ThisWorkbook. I have read
Chip Pearson site and seen some examples by Bob Phillips which I am
trying to replicate without much look. I returns a syntax error. I am
aware of the Trusted VBA and Reference to Microsoft VBA Extensibility.
The code I am running is as follows. Could anyone assist?




Sub Populate_TW()

Dim StartLine As Long

With
ActiveWorkbook.VBProject.VBComponents("ThisWorkboo k").CodeModule
StartLine = .CreateEventProc("Open", "Workbook") + 1
.InsertLines StartLine, _
"Application.ScreenUpdating = False"& vbCrLf & _
"Dim sh As Worksheet"& vbCrLf & _
"For Each sh In ThisWorkbook.Worksheets"& vbCrLf & _
"sh.Select"& vbCrLf & _
"Application.GoTo Reference:=sh.Range("a1"), Scroll:=True"& vbCrLf &
_
"Next sh"& vbCrLf & _
"ThisWorkbook.Sheets("Input").Select"& vbCrLf & _
"Application.ScreenUpdating = True"& vbCrLf & _
"Dim myArray As Variant"& vbCrLf & _
"Dim arName As String"& vbCrLf & _
"arName = "Users""& vbCrLf & _
"myArray = ThisWorkbook.Names(arName).RefersToRange.Value"& vbCrLf & _
"With Application"& vbCrLf & _
"If IsError(.Match(.UserName, myArray, 0)) Then"& vbCrLf & _
"ThisWorkbook.Sheets("Blank Sheet").Select"& vbCrLf &_
"MsgBox "You are NOT Permitted to access this File " & vbNewLine & _"&
vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""Please Contact " & vbNewLine & _"& vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""Joe Bloggs at " & vbNewLine & _"& vbCrLf & _
"" " & vbNewLine & _"& vbCrLf & _
""ABCGroup +0019 69944000""& vbCrLf & _
"Application.DisplayAlerts = False"& vbCrLf & _
"ThisWorkbook.Close False"& vbCrLf & _
"Else"& vbCrLf & _
"End If"& vbCrLf & _
"End With"& vbCrLf & _
"ThisWorkbook.Sheets("Input").Select"
End Sub

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

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

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

I've hit a snag, with addingto my permitted list within the code, I'm
sure its about continuation of lines but can't figure it out, here is
the problem lines. In effect I've 2 lines of users

"If .UserName = ""User1"" Or .UserName = ""User2"" Or .UserName =
""User3"" Or .UserName = ""User4"" Or .UserName = ""User5"" Or
..UserName = ""User6"" Or .UserName = ""User7"" & vbCr & _" & vbCr & _
"If .UserName = ""User8"" Or .UserName = ""User9"" Or .UserName =
""User10"" Or .UserName = ""User11"" Or .UserName = ""User12"" Or
..UserName = ""User13"" Then"



Sean wrote:

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

You can't completely get around that, but you get pretty close with the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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

Sean,

You would be MUCH better off using a Select Case statement. E.g.,

Select Case .UserName
Case "User1", "User2", "User3"
' do something
Case "User4", "User5", "User6"
' do something else
Case Else
' do something if no match above
End Select


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)




"Sean" wrote in message
ps.com...
I've hit a snag, with addingto my permitted list within the code, I'm
sure its about continuation of lines but can't figure it out, here is
the problem lines. In effect I've 2 lines of users

"If .UserName = ""User1"" Or .UserName = ""User2"" Or .UserName =
""User3"" Or .UserName = ""User4"" Or .UserName = ""User5"" Or
.UserName = ""User6"" Or .UserName = ""User7"" & vbCr & _" & vbCr & _
"If .UserName = ""User8"" Or .UserName = ""User9"" Or .UserName =
""User10"" Or .UserName = ""User11"" Or .UserName = ""User12"" Or
.UserName = ""User13"" Then"



Sean wrote:

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

Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub




Chip Pearson wrote:

You can't completely get around that, but you get pretty close with the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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

I guess True and False are the opposite way around!

Sean wrote:

Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub




Chip Pearson wrote:

You can't completely get around that, but you get pretty close with the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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

Sean,

Take out the line

Application.VBE.MainWindow.Visible = True

I have no idea what I was thinking when I put line of code on the web site.
I'll look back over the page to see if that line serves any purpose. I think
it is a mistake.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
oups.com...
Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub




Chip Pearson wrote:

You can't completely get around that, but you get pretty close with the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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

Chip I tried your other code but get a compile error "only comment may
appear after End sub etc". I placed it like the following

Sub Populate_TW()

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long


Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If

' My Code in Here

Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub





Chip Pearson wrote:

Sean,

Take out the line

Application.VBE.MainWindow.Visible = True

I have no idea what I was thinking when I put line of code on the web site.
I'll look back over the page to see if that line serves any purpose. I think
it is a mistake.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
oups.com...
Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub




Chip Pearson wrote:

You can't completely get around that, but you get pretty close with the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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

Sean,

The Private Declare statements must not be within a Sub or Function
procedure. They must appear outside of and above any procedure in the
module, right after "Option Explicit" (and you are using "Option Explicit"
aren't you?).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
Chip I tried your other code but get a compile error "only comment may
appear after End sub etc". I placed it like the following

Sub Populate_TW()

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long


Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If

' My Code in Here

Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub





Chip Pearson wrote:

Sean,

Take out the line

Application.VBE.MainWindow.Visible = True

I have no idea what I was thinking when I put line of code on the web
site.
I'll look back over the page to see if that line serves any purpose. I
think
it is a mistake.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
oups.com...
Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub




Chip Pearson wrote:

You can't completely get around that, but you get pretty close with
the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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

Chip, I have no idea. But I did get it working, the way it is supposed
to, thanks for your guidance


Chip Pearson wrote:

Sean,

The Private Declare statements must not be within a Sub or Function
procedure. They must appear outside of and above any procedure in the
module, right after "Option Explicit" (and you are using "Option Explicit"
aren't you?).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
Chip I tried your other code but get a compile error "only comment may
appear after End sub etc". I placed it like the following

Sub Populate_TW()

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hWndLock As Long) As Long


Dim VBEHwnd As Long
On Error GoTo ErrH:
Application.VBE.MainWindow.Visible = False
VBEHwnd = FindWindow("wndclass_desked_gsk", _
Application.VBE.MainWindow.Caption)
If VBEHwnd Then
LockWindowUpdate VBEHwnd
End If

' My Code in Here

Application.VBE.MainWindow.Visible = False
ErrH:
LockWindowUpdate 0&
End Sub





Chip Pearson wrote:

Sean,

Take out the line

Application.VBE.MainWindow.Visible = True

I have no idea what I was thinking when I put line of code on the web
site.
I'll look back over the page to see if that line serves any purpose. I
think
it is a mistake.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
oups.com...
Chip, I placed the following code from your site but the Editor still
remains open once the code is completed. Not too worried about the
flicker

Sub Populate_TW()
Application.VBE.MainWindow.Visible = False
Dim StartLine As Long
Dim msg1 As String, msg2 As String

'
' My Code is in here
'
Application.VBE.MainWindow.Visible = True
End Sub




Chip Pearson wrote:

You can't completely get around that, but you get pretty close with
the
"Eliminating Screen Flickering" section near the bottom of
http://www.cpearson.com/excel/vbe.htm


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"Sean" wrote in message
ups.com...
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