asked on

Stop VBA Window from popping up

I have a code that creates a code in a module, but when it does the VBA window flashes up while the code is running.
I have tried 'Application.screenupdating = false', and it does not work, I have also tried 'ThisWorkbook.VBProject.VBE.MainWindow.Visible = False' at the beginning and end of the code but the window still pops up for a short time. I would like to run the code without the vba window being visable at all.

this is the code:

Sub code

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.add(vbext_ct_StdModule)
vbc.Name = "CreateButton"
strCode = "Sub CreateButtons()" & vbNewLine & _
"ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
" Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
"Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
" With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
" .Size = 10" & vbNewLine & _
" End With" & vbNewLine & _
"ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
" Selection.OnAction = ""UNM23Report""" & vbNewLine & _
"Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
" With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
" .Size = 10" & vbNewLine & _
" End With" & vbNewLine & _
"ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
" Selection.OnAction = ""SPLEtool""" & vbNewLine & _
"Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
" With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
" .Size = 10" & vbNewLine & _
" End With" & vbNewLine & _
" End Sub"

vbc.CodeModule.AddFromString strCode
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

End Sub

Shums Faruk

Hi Jen,

Move this line ThisWorkbook.VBProject.VBE.MainWindow.Visible = False at the start of your code

Sub code
   
        Set vbp = Application.VBE.ActiveVBProject
    Set vbc = vbp.VBComponents.add(vbext_ct_StdModule)
   ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
    vbc.Name = "CreateButton"
    strCode = "Sub CreateButtons()" & vbNewLine & _
    "ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
    "Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""UNM23Report""" & vbNewLine & _
    "Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""SPLEtool""" & vbNewLine & _
    "Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
  " End Sub"
    
        vbc.CodeModule.AddFromString strCode
  
End Sub

Open in new window

Jen Payne

ASKER

When i put it at the beginning, it doesn't close the window at all. The code is called from another code that is running, the first code creates folders/sub-folders and files within the folders, so the code above creates the codes and modules in another workbook, would that make a difference?

Shums Faruk

Add Application.ScreenUpdating = False & Application.DisplayAlert = False at the beginning which may stop.

Sub code()
   
        Set vbp = Application.VBE.ActiveVBProject
    Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
    vbc.Name = "CreateButton"
    strCode = "Sub CreateButtons()" & vbNewLine & _
    "ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
    "Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""UNM23Report""" & vbNewLine & _
    "Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""SPLEtool""" & vbNewLine & _
    "Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
  " End Sub"
    
        vbc.CodeModule.AddFromString strCode
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Open in new window

Jen Payne

ASKER

Thank you, I will try it now, my full code is actually this:

Sub code ()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ActiveSheet.CodeName)
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CreateEventProc("Change", "Worksheet")
LineNum = LineNum + 1
.InsertLines LineNum, " If Target.Address = ""$C$9"" Then"
LineNum = LineNum + 1
.InsertLines LineNum, " If Target.Value = ""Yes"" Then"
LineNum = LineNum + 1
.InsertLines LineNum, " Call CreateButtons"
LineNum = LineNum + 1
.InsertLines LineNum, " Range(""$C$9"").Select"
LineNum = LineNum + 1
.InsertLines LineNum, " else"
LineNum = LineNum + 1
.InsertLines LineNum, " Range(""$C$9"").Select"
LineNum = LineNum + 1
.InsertLines LineNum, "End if"
LineNum = LineNum + 1
.InsertLines LineNum, "End if"
LineNum = LineNum + 1

.InsertLines LineNum, " If Target.Address = ""$C$24"" Then"
LineNum = LineNum + 1
.InsertLines LineNum, " If Target.Value = ""Yes"" Then"
LineNum = LineNum + 1
.InsertLines LineNum, " ActiveSheet.Rows(""25:30"").EntireRow.Hidden = True"
LineNum = LineNum + 1
.InsertLines LineNum, " Else"
LineNum = LineNum + 1
.InsertLines LineNum, " ActiveSheet.Rows(""24:31"").EntireRow.Hidden = False"
LineNum = LineNum + 1
.InsertLines LineNum, " End If"
LineNum = LineNum + 1
.InsertLines LineNum, "End If"

End With

Dim vbp As VBProject
Dim vbc As VBComponent
Dim strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.add(vbext_ct_StdModule)
vbc.Name = "ClaimsLog1"
strCode = "Sub ClaimsLog()" & vbNewLine & _
" Workbooks.Open Filename:= _" & vbNewLine & _
" ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\JP\LOGS\International MR Claims Raised Log.xlsm"" " & vbNewLine & _
"End Sub"
vbc.CodeModule.AddFromString strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.add(vbext_ct_StdModule)
vbc.Name = "UNM23Report1"
strCode = "Sub UNM23Report()" & vbNewLine & _
" Dim MyPath As String" & vbNewLine & _
" Dim latestFile As String" & vbNewLine & _
" Dim LatestDate As Date" & vbNewLine & _
" Dim LMD As Date" & vbNewLine & _
" MyPath = ""G:\Music Reporting & Distribution\1. Music Reporting\1.12 MR Operations\International\11. UNM23 Report\""" & vbNewLine & _
" If Right(MyPath, 1) <> ""\"" Then MyPath = MyPath & ""\""" & vbNewLine & _
" MyFile = Dir(MyPath & ""*.xlsm"", vbNormal)" & vbNewLine & _
" If Len(MyFile) = 0 Then" & vbNewLine & _
" MsgBox ""No files were found..."", vbExclamation" & vbNewLine & _
" Exit Sub" & vbNewLine & _
" End If" & vbNewLine & _
" Do While Len(MyFile) > 0" & vbNewLine & _
" LMD = FileDateTime(MyPath & MyFile)" & vbNewLine & _
" If LMD > LatestDate Then" & vbNewLine & _
" latestFile = MyFile" & vbNewLine & _
" LatestDate = LMD" & vbNewLine & _
" End If" & vbNewLine & _
" MyFile = Dir" & vbNewLine & _
" Loop" & vbNewLine & _
"Workbooks.Open MyPath & latestFile" & vbNewLine & _
"End Sub"
vbc.CodeModule.AddFromString strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.add(vbext_ct_StdModule)
vbc.Name = "SPLEtool1"
strCode = "Sub SPLEtool()" & vbNewLine & _
" Workbooks.Open Filename:= _" & vbNewLine & _
" ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\SPLE SEARCH TOOL\FIND_SPLES_MACRO.xlsm"" " & vbNewLine & _
"End Sub"
vbc.CodeModule.AddFromString strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.add(vbext_ct_StdModule)
vbc.Name = "CreateButton"
strCode = "Sub CreateButtons()" & vbNewLine & _
"ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
" Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
"Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
" With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
" .Size = 10" & vbNewLine & _
" End With" & vbNewLine & _
"ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
" Selection.OnAction = ""UNM23Report""" & vbNewLine & _
"Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
" With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
" .Size = 10" & vbNewLine & _
" End With" & vbNewLine & _
"ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
" Selection.OnAction = ""SPLEtool""" & vbNewLine & _
"Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
" With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
" .Size = 10" & vbNewLine & _
" End With" & vbNewLine & _
" End Sub"

vbc.CodeModule.AddFromString strCode

End sub

Shums Faruk

Its difficult to read your lengthy code, but try below:

Sub Code()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ActiveSheet.CodeName)
Set CodeMod = VBComp.CodeModule
        
With CodeMod
    LineNum = .CreateEventProc("Change", "Worksheet")
    LineNum = LineNum + 1
        .InsertLines LineNum, "    If Target.Address = ""$C$9"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "    If Target.Value = ""Yes"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  Call CreateButtons"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  Range(""$C$9"").Select"
    LineNum = LineNum + 1
        .InsertLines LineNum, " else"
    LineNum = LineNum + 1
        .InsertLines LineNum, " Range(""$C$9"").Select"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End if"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End if"
    LineNum = LineNum + 1
        .InsertLines LineNum, " If Target.Address = ""$C$24"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, " If Target.Value = ""Yes"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "   ActiveSheet.Rows(""25:30"").EntireRow.Hidden = True"
    LineNum = LineNum + 1
        .InsertLines LineNum, " Else"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  ActiveSheet.Rows(""24:31"").EntireRow.Hidden = False"
    LineNum = LineNum + 1
        .InsertLines LineNum, " End If"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End If"
End With

Dim vbp As VBProject
Dim vbc As VBComponent
Dim strCode

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "ClaimsLog1"
strCode = "Sub ClaimsLog()" & vbNewLine & _
                                    "    Workbooks.Open Filename:= _" & vbNewLine & _
                                    "  ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\JP\LOGS\International MR Claims Raised Log.xlsm"" " & vbNewLine & _
                                    "End Sub"
vbc.CodeModule.AddFromString strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "UNM23Report1"
strCode = "Sub UNM23Report()" & vbNewLine & _
" Dim MyPath As String" & vbNewLine & _
" Dim latestFile As String" & vbNewLine & _
 " Dim LatestDate As Date" & vbNewLine & _
 " Dim LMD As Date" & vbNewLine & _
 " MyPath = ""G:\Music Reporting & Distribution\1. Music Reporting\1.12 MR Operations\International\11. UNM23 Report\""" & vbNewLine & _
   " If Right(MyPath, 1) <> ""\"" Then MyPath = MyPath & ""\""" & vbNewLine & _
 " MyFile = Dir(MyPath & ""*.xlsm"", vbNormal)" & vbNewLine & _
  " If Len(MyFile) = 0 Then" & vbNewLine & _
  "  MsgBox ""No files were found..."", vbExclamation" & vbNewLine & _
  "   Exit Sub" & vbNewLine & _
 "   End If" & vbNewLine & _
    " Do While Len(MyFile) > 0" & vbNewLine & _
      "   LMD = FileDateTime(MyPath & MyFile)" & vbNewLine & _
   "   If LMD > LatestDate Then" & vbNewLine & _
   "      latestFile = MyFile" & vbNewLine & _
      "      LatestDate = LMD" & vbNewLine & _
 "   End If" & vbNewLine & _
 "   MyFile = Dir" & vbNewLine & _
" Loop" & vbNewLine & _
 "Workbooks.Open MyPath & latestFile" & vbNewLine & _
 "End Sub"
vbc.CodeModule.AddFromString strCode
    
Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "SPLEtool1"
strCode = "Sub SPLEtool()" & vbNewLine & _
                                    "    Workbooks.Open Filename:= _" & vbNewLine & _
                                    "  ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\SPLE SEARCH TOOL\FIND_SPLES_MACRO.xlsm"" " & vbNewLine & _
                                    "End Sub"
    vbc.CodeModule.AddFromString strCode
    
Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "CreateButton"
strCode = "Sub CreateButtons()" & vbNewLine & _
    "ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
    "Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""UNM23Report""" & vbNewLine & _
    "Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""SPLEtool""" & vbNewLine & _
    "Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
  " End Sub"
vbc.CodeModule.AddFromString strCode

Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.VBProject.VBE.MainWindow.Visible = True
End Sub

Open in new window

Jen Payne

ASKER

Yes I know it's very long thank you for looking at it for me. that was a little better, the VBA window only flashed up for about half a second

Norie

Which module(s) are you trying to add the code to?

Shums Faruk

I think below code will not display even for half a second :)

Sub Code()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ActiveSheet.CodeName)
Set CodeMod = VBComp.CodeModule

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With CodeMod
    LineNum = .CreateEventProc("Change", "Worksheet")
    LineNum = LineNum + 1
        .InsertLines LineNum, "    If Target.Address = ""$C$9"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "    If Target.Value = ""Yes"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  Call CreateButtons"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  Range(""$C$9"").Select"
    LineNum = LineNum + 1
        .InsertLines LineNum, " else"
    LineNum = LineNum + 1
        .InsertLines LineNum, " Range(""$C$9"").Select"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End if"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End if"
    LineNum = LineNum + 1
        .InsertLines LineNum, " If Target.Address = ""$C$24"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, " If Target.Value = ""Yes"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "   ActiveSheet.Rows(""25:30"").EntireRow.Hidden = True"
    LineNum = LineNum + 1
        .InsertLines LineNum, " Else"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  ActiveSheet.Rows(""24:31"").EntireRow.Hidden = False"
    LineNum = LineNum + 1
        .InsertLines LineNum, " End If"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End If"
End With

Dim vbp As VBProject
Dim vbc As VBComponent
Dim strCode

ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "ClaimsLog1"
strCode = "Sub ClaimsLog()" & vbNewLine & _
                                    "    Workbooks.Open Filename:= _" & vbNewLine & _
                                    "  ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\JP\LOGS\International MR Claims Raised Log.xlsm"" " & vbNewLine & _
                                    "End Sub"
vbc.CodeModule.AddFromString strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "UNM23Report1"
strCode = "Sub UNM23Report()" & vbNewLine & _
" Dim MyPath As String" & vbNewLine & _
" Dim latestFile As String" & vbNewLine & _
 " Dim LatestDate As Date" & vbNewLine & _
 " Dim LMD As Date" & vbNewLine & _
 " MyPath = ""G:\Music Reporting & Distribution\1. Music Reporting\1.12 MR Operations\International\11. UNM23 Report\""" & vbNewLine & _
   " If Right(MyPath, 1) <> ""\"" Then MyPath = MyPath & ""\""" & vbNewLine & _
 " MyFile = Dir(MyPath & ""*.xlsm"", vbNormal)" & vbNewLine & _
  " If Len(MyFile) = 0 Then" & vbNewLine & _
  "  MsgBox ""No files were found..."", vbExclamation" & vbNewLine & _
  "   Exit Sub" & vbNewLine & _
 "   End If" & vbNewLine & _
    " Do While Len(MyFile) > 0" & vbNewLine & _
      "   LMD = FileDateTime(MyPath & MyFile)" & vbNewLine & _
   "   If LMD > LatestDate Then" & vbNewLine & _
   "      latestFile = MyFile" & vbNewLine & _
      "      LatestDate = LMD" & vbNewLine & _
 "   End If" & vbNewLine & _
 "   MyFile = Dir" & vbNewLine & _
" Loop" & vbNewLine & _
 "Workbooks.Open MyPath & latestFile" & vbNewLine & _
 "End Sub"
vbc.CodeModule.AddFromString strCode
    
Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "SPLEtool1"
strCode = "Sub SPLEtool()" & vbNewLine & _
                                    "    Workbooks.Open Filename:= _" & vbNewLine & _
                                    "  ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\SPLE SEARCH TOOL\FIND_SPLES_MACRO.xlsm"" " & vbNewLine & _
                                    "End Sub"
    vbc.CodeModule.AddFromString strCode
    
Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "CreateButton"
strCode = "Sub CreateButtons()" & vbNewLine & _
    "ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
    "Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""UNM23Report""" & vbNewLine & _
    "Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""SPLEtool""" & vbNewLine & _
    "Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
  " End Sub"
vbc.CodeModule.AddFromString strCode

Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.VBProject.VBE.MainWindow.Visible = True
End Sub

Open in new window

Jen Payne

ASKER

Hi Norie the code is inserted in a module within a new sheet

Jen Payne

ASKER

Thank you Shums, the window is still popping up, this time for longer (until the rest of the code has finished running)

Shums Faruk

Then switch back to the previous code :)

Sub Code()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(ActiveSheet.CodeName)
Set CodeMod = VBComp.CodeModule
        
With CodeMod
    LineNum = .CreateEventProc("Change", "Worksheet")
    LineNum = LineNum + 1
        .InsertLines LineNum, "    If Target.Address = ""$C$9"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "    If Target.Value = ""Yes"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  Call CreateButtons"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  Range(""$C$9"").Select"
    LineNum = LineNum + 1
        .InsertLines LineNum, " else"
    LineNum = LineNum + 1
        .InsertLines LineNum, " Range(""$C$9"").Select"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End if"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End if"
    LineNum = LineNum + 1
        .InsertLines LineNum, " If Target.Address = ""$C$24"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, " If Target.Value = ""Yes"" Then"
    LineNum = LineNum + 1
        .InsertLines LineNum, "   ActiveSheet.Rows(""25:30"").EntireRow.Hidden = True"
    LineNum = LineNum + 1
        .InsertLines LineNum, " Else"
    LineNum = LineNum + 1
        .InsertLines LineNum, "  ActiveSheet.Rows(""24:31"").EntireRow.Hidden = False"
    LineNum = LineNum + 1
        .InsertLines LineNum, " End If"
    LineNum = LineNum + 1
        .InsertLines LineNum, "End If"
End With

Dim vbp As VBProject
Dim vbc As VBComponent
Dim strCode

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.VBProject.VBE.MainWindow.Visible = False

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "ClaimsLog1"
strCode = "Sub ClaimsLog()" & vbNewLine & _
                                    "    Workbooks.Open Filename:= _" & vbNewLine & _
                                    "  ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\JP\LOGS\International MR Claims Raised Log.xlsm"" " & vbNewLine & _
                                    "End Sub"
vbc.CodeModule.AddFromString strCode

Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "UNM23Report1"
strCode = "Sub UNM23Report()" & vbNewLine & _
" Dim MyPath As String" & vbNewLine & _
" Dim latestFile As String" & vbNewLine & _
 " Dim LatestDate As Date" & vbNewLine & _
 " Dim LMD As Date" & vbNewLine & _
 " MyPath = ""G:\Music Reporting & Distribution\1. Music Reporting\1.12 MR Operations\International\11. UNM23 Report\""" & vbNewLine & _
   " If Right(MyPath, 1) <> ""\"" Then MyPath = MyPath & ""\""" & vbNewLine & _
 " MyFile = Dir(MyPath & ""*.xlsm"", vbNormal)" & vbNewLine & _
  " If Len(MyFile) = 0 Then" & vbNewLine & _
  "  MsgBox ""No files were found..."", vbExclamation" & vbNewLine & _
  "   Exit Sub" & vbNewLine & _
 "   End If" & vbNewLine & _
    " Do While Len(MyFile) > 0" & vbNewLine & _
      "   LMD = FileDateTime(MyPath & MyFile)" & vbNewLine & _
   "   If LMD > LatestDate Then" & vbNewLine & _
   "      latestFile = MyFile" & vbNewLine & _
      "      LatestDate = LMD" & vbNewLine & _
 "   End If" & vbNewLine & _
 "   MyFile = Dir" & vbNewLine & _
" Loop" & vbNewLine & _
 "Workbooks.Open MyPath & latestFile" & vbNewLine & _
 "End Sub"
vbc.CodeModule.AddFromString strCode
    
Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "SPLEtool1"
strCode = "Sub SPLEtool()" & vbNewLine & _
                                    "    Workbooks.Open Filename:= _" & vbNewLine & _
                                    "  ""G:\Music Reporting & Distribution\1. Music Reporting\1.9 Drawing Boards\Jennifer Payne\SPLE SEARCH TOOL\FIND_SPLES_MACRO.xlsm"" " & vbNewLine & _
                                    "End Sub"
    vbc.CodeModule.AddFromString strCode
    
Set vbp = Application.VBE.ActiveVBProject
Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
vbc.Name = "CreateButton"
strCode = "Sub CreateButtons()" & vbNewLine & _
    "ActiveSheet.Buttons.Add(840, 10, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""ClaimsLog""" & vbNewLine & _
    "Selection.Characters.Text = ""Claims Log"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 40, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""UNM23Report""" & vbNewLine & _
    "Selection.Characters.Text = ""UNM23 Report"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
 "ActiveSheet.Buttons.Add(840, 70, 95, 25).Select " & vbNewLine & _
   " Selection.OnAction = ""SPLEtool""" & vbNewLine & _
    "Selection.Characters.Text = ""SPLE Tool"" " & vbNewLine & _
  "  With Selection.Characters(Start:=1, Length:=35).Font " & vbNewLine & _
      "  .Size = 10" & vbNewLine & _
   " End With" & vbNewLine & _
  " End Sub"
vbc.CodeModule.AddFromString strCode

Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.VBProject.VBE.MainWindow.Visible = True
End Sub

Open in new window

Norie

Do the subs being created all need to go in separate modules?

Jen Payne

ASKER

Yes they all go into new (separate) modules, but they don't need to.

Norie

The reason I'm asking is because I think, though I'm not 100% sure, that what's causing the VBE to pop up is the addition of new modules.

If that is the case then adding the code for the new subs to an existing module might solve the problem.

Jen Payne

ASKER

Right ok, that would make sense. A new module would need to be created because it is a new worksheet, which is saved as a new workbook, if that makes sense.

Norie

Are you creating an entirely new workbook with this code residing in a separate workbook?

Jen Payne

ASKER

Yes, that is basically what I'm doing, so the code actually goes into a new workbook and is later assigned to a button.

Norie

Have you considered using a template workbook with the code already in it?

Jen Payne

ASKER

I initially had a code attached to a temp worksheet but when I saved it and re-opened it the code was still 'attached' to the original workbook not the new workbook

ASKER CERTIFIED SOLUTION

Norie

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Jen Payne

ASKER

There are a few possible worksheets (different versions of checklists). the worksheet is exported, so it is already a temp worksheet within the workbook. the code I would like to add open different workbooks and also do a few other things.

If I put the codes in each temp worksheet, will it slow the script down? I have a bout 15 different sheets

Shums Faruk

Hi Jen,

After 20 days you came back with another problem, if non of the solution worked for you, then I would request you to please delete this question and raise another one with exactly what you want to do.

Regards,
Shums