I'm having trouble i have an excel document where i create code on a sheet using the code below. it works however it keeps opening the VBE window becuase it thinks i've typed in the code! how can i stop it from opening the window. i have tride
Application.VBE.MainWindow.Close (causes an error)
and
Application.ScreenUpdating = False (does nothing)
and
Application.VBE.MainWindow.Visible = True (does nothing)
here is the code: (this is in a module)
Sub test()
Dim oOLE, oOLE2, oOLE3 As OLEObject
Dim oWs As Worksheet
Application.VBE.MainWindow.Visible = False
Set oWs = Activesheet
Set oOLE = Activesheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=450, Top:=100, Width:=100, Height:=20)
Set oOLE2 = Activesheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=450, Top:=150, Width:=100, Height:=20)
Set oOLE3 = Activesheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=450, Top:=200, Width:=100, Height:=20)
With oOLE
.Object.Caption = "Sort By Name"
.Name = "SortName"
End With
With oOLE2
.Object.Caption = "Sort Site Name"
.Name = "SortSite"
End With
With oOLE3
.Object.Caption = "Sort Country"
.Name = "Country"
End With
With ThisWorkbook.VBProject.VBComponents(oWs.CodeName).CodeModule
.InsertLines .CreateEventProc("Click", oOLE.Name) + 1, _
vbTab & "Range(""A4"").Select" & vbCrLf & _
vbTab & "Range(Selection, Selection.End(xlToRight)).Select" & vbCrLf & _
vbTab & "Range(Selection, Selection.End(xlDown)).Select" & vbCrLf & _
vbTab & "Selection.sort Key1:=Range(""B5""), Order1:=xlAscending, Header:=xlGuess, _" & vbCrLf & _
vbTab & "OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom" & vbCrLf & _
vbTab & "Range(""F18"").Select"
End With
With ThisWorkbook.VBProject.VBComponents(oWs.CodeName).CodeModule
.InsertLines .CreateEventProc("Click", oOLE2.Name) + 1, _
vbTab & "Range(""A4"").Select" & vbCrLf & _
vbTab & "Range(Selection, Selection.End(xlToRight)).Select" & vbCrLf & _
vbTab & "Range(Selection, Selection.End(xlDown)).Select" & vbCrLf & _
vbTab & "Selection.sort Key1:=Range(""C5""), Order1:=xlAscending, Header:=xlGuess, _" & vbCrLf & _
vbTab & "OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom" & vbCrLf & _
vbTab & "Range(""F18"").Select"
End With
With ThisWorkbook.VBProject.VBComponents(oWs.CodeName).CodeModule
.InsertLines .CreateEventProc("Click", oOLE3.Name) + 1, _
vbTab & "Range(""A4"").Select" & vbCrLf & _
vbTab & "Range(Selection, Selection.End(xlToRight)).Select" & vbCrLf & _
vbTab & "Range(Selection, Selection.End(xlDown)).Select" & vbCrLf & _
vbTab & "Selection.sort Key1:=Range(""D5""), Order1:=xlAscending, Header:=xlGuess, _" & vbCrLf & _
vbTab & "OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom" & vbCrLf & _
vbTab & "Range(""F18"").Select"
End With
End Sub
here is where test is started
(this is in the work book)
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim I, check As Single
Dim product, title As String
Application.VBE.MainWindow.Visible = False
I = 1
check = 0
Do While I <> 60
If Activesheet.Name = ("Sheet" & I) And Range("A1").Value = "Product" Then
check = 1
Activesheet.Name = "Selection Drill Down_" & I
Rows("1:1").Select
Selection.Insert
Selection.Insert
Selection.Insert
title = Range("C5").Value 'selecting doc title
product = Range("A5").Value 'selecting doc title
Columns("A:C").Select
Selection.Delete
Columns("B:B").Select
Selection.Delete
Range("A1").Value = "Title >>"
Range("A2").Value = "Product >>"
Range("B1").Value = title
Range("B2").Value = product
'----------------------------Formating-----------------------------------------
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.ColorIndex = 1
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
'----------------------------end of Formating-----------------------------------------
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
End If
I = I + 1
Loop
If check = 1 Then
Call test
End If
End Sub
helphelphelphelphelphelphelphelp
Bookmarks