run two module at excel start up - vba

I have two modules that i would like to be executed at the open of the workbook what is the best way to do that. below are my module.
module 1
Public Sub workbook_open()
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you Agree?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "Do you agree with disclaimer")
If YesOrNoAnswerToMessageBox = vbNo Then
ActiveWorkbook.Close savechanges:=False
Else
MsgBox "Congratulations!"
End If
End Sub
module 2
Sub workbook_open()
Dim Expired As Date
Expired = "31 March 2016"
If Now() < Expired Then
Sheet1.Visible = True
Sheet2.Visible = True
Sheet3.Visible = True
Sheet6.Visible = True
Sheet7.Visible = True
Sheet8.Visible = True
Sheet9.Visible = True
Sheet13.Visible = True
Sheet5.Visible = True
Sheet10.Visible = xlSheetHidden
End If
If Now() > Expired Then
MsgBox "This file is no longer in use!"
Sheet10.Visible = True
Sheet1.Visible = xlSheetVeryHidden
Sheet2.Visible = xlSheetVeryHidden
Sheet3.Visible = xlSheetVeryHidden
Sheet6.Visible = xlSheetVeryHidden
Sheet7.Visible = xlSheetVeryHidden
Sheet9.Visible = xlSheetVeryHidden
Sheet13.Visible = xlSheetVeryHidden
Sheet5.Visible = xlSheetVeryHidden
Sheet8.Visible = xlSheetVeryHidden
End If
End Sub


The Workbook_Open() event has do be declared in the ThisWorkbook module, not a standard code module.
You can rename your current procedures and just call them both from the open event like so:
In Module1:
Sub Foo()
MsgBox "First Message"
End Sub
In Module2:
Sub Bar()
MsgBox "Second Message"
End Sub
Then in the ThisWorkbook module:
Public Sub Workbook_Open()
Foo
Bar
End Sub
Looking at your existing code, you just need to incorporate the second sub in your If block:
In the ThisWorkbook module:
Public Sub workbook_open()
Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String
QuestionToMessageBox = "Do you Agree?"
YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "Do you agree with disclaimer")
If YesOrNoAnswerToMessageBox = vbNo Then
ActiveWorkbook.Close savechanges:=False
Else
MsgBox "Congratulations!"
OpeningProcedure '// <~~ Note this, to call the other sub
End If
End Sub
and in Module1:
Sub OpeningProcedure()
Dim Expired As Date Expired = "31 March 2016"
If Now() < Expired Then
Sheet1.Visible = True
Sheet2.Visible = True
Sheet3.Visible = True
Sheet6.Visible = True
Sheet7.Visible = True
Sheet8.Visible = True
Sheet9.Visible = True
Sheet13.Visible = True
Sheet5.Visible = True
Sheet10.Visible = xlSheetHidden
End If
If Now() > Expired Then
MsgBox "This file is no longer in use!"
Sheet10.Visible = True
Sheet1.Visible = xlSheetVeryHidden
Sheet2.Visible = xlSheetVeryHidden
Sheet3.Visible = xlSheetVeryHidden
Sheet6.Visible = xlSheetVeryHidden
Sheet7.Visible = xlSheetVeryHidden
Sheet9.Visible = xlSheetVeryHidden
Sheet13.Visible = xlSheetVeryHidden
Sheet5.Visible = xlSheetVeryHidden
Sheet8.Visible = xlSheetVeryHidden
End If
End Sub

Related

Add a second bookmark to the same yes no button

I've created a yes no button that hides a bookmark, how can i add a second bookmark to the same yes no button. My Bookmarks name is TextToShow. i just want to add another bookmark to the same field.
Private Sub CheckBoxNo_Change()
Call ShowHideBookmark
End Sub
Sub ShowHideBookmark()
Dim Sterilisation As Range
Set Sterilisation = ActiveDocument.Bookmarks("TextToShow").Range
If CheckBoxNo.Value = True Then
With Sterilisation.Font
.Hidden = True
End With
With ActiveWindow.View
.ShowHiddenText = False
.ShowAll = False
End With
Else
With Sterilisation.Font
.Hidden = False
End With
With ActiveWindow.View
.ShowHiddenText = True
.ShowAll = True
End With
End If
End Sub

Sub ShowHideBookmark()
Dim Sterilisation As Range, Sterilisation2 As Range
Set Sterilisation = ActiveDocument.Bookmarks("TextToShow").Range
Set Sterilisation2 = ActiveDocument.Bookmarks("TextToShow2").Range
If CheckBoxNo.value = True Then
Sterilisation.Font.Hidden = True
Sterilisation2.Font.Hidden = True
With ActiveWindow.View
.ShowHiddenText = False
.ShowAll = False
End With
Else
Sterilisation.Font.Hidden = False
Sterilisation2.Font.Hidden = False
With ActiveWindow.View
.ShowHiddenText = True
.ShowAll = True
End With
End If
End Sub

Assuming (as per JK's approach) your second bookmarked range is named 'TextToShow2', try:
Private Sub CheckBoxNo_Change()
Application.ScreenUpdating = False
Dim bVal As Boolean: bVal = CheckBoxNo.Value
ActiveDocument.Bookmarks("TextToShow").Range.Font.Hidden = bVal
ActiveDocument.Bookmarks("TextToShow2").Range.Font.Hidden = bVal
ActiveWindow.View.ShowHiddenText = Not bVal
ActiveWindow.View.ShowAll = Not bVal
Application.ScreenUpdating = True
End Sub

Configuring my radiobuttons so they import text from a UserForm to a bookmark

I am doing a document using a userform. In the userform I setup radiobuttons when clicked I want the text from a macro that I did to be inserted at a specific bookmark in my document. Help please
This is my macro:
Sub ordonnance()
'
' ORDONNANCE Macro
'
'
Dim bmSignet As Bookmark
Dim rgPlageDuSignet As Range
Set bmSignet = ActiveDocument.Bookmarks("ORDONNANCE_DE")
Set rgPlageDuSignet = bmSignet.Range
rgPlageDuSignet.Select
ActiveDocument.Tables.Add rgPlageDuSignet, 1, 1
With Selection.Tables(1)
If .Style <> "Grille du tableau" Then
.Style = "Grille du tableau"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.Font.Name = "Arial"
Selection.Font.Size = 12
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="ORDONNANCE DE NON-PUBLICATION ..."
Set bmSignet = Nothing
Set rgPlageDuSignet = Nothing
End Sub
This is my radiobutton:
Private Sub OptionButton3_Click()
If Me.OptionButton3.Value = True Then
Call RemplaceSignet("ORDONNANCE_DE", "ORDONNANCE DE NON-PUBLICATION ...")
Else
Call RemplaceSignet("ORDONNANCE_DE", " ")
End If
End Sub

Try:
Sub ordonnance(StrBkMk As String, StrTxt As String)
'
' ORDONNANCE Macro
'
'
Dim Tbl As Table
With ActiveDocument
Set Tbl = .Tables.Add(.Bookmarks(StrBkMk).Range, 1, 1)
With Tbl
.Style = "Grille du tableau"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
With .Cell(1, 1).Range
With .Font
.Name = "Arial"
.Size = 12
.Bold = True
End With
.Text = StrTxt
End With
End With
End With
Set Tbl = Nothing
End Sub
Note that there is no need to select anything.

Compiler error on if statement

I am new to coding/scripting. Its a school project, I would have to change the below code to add Application.EnableEvents to the existing code to suppress the Change event in other macros.
I tried to change the code, but I get a compile error else without if. I validated the syntax, it looks OK. What am I doing wrong here? Is my understanding with "IF" statements not correct?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then Call Class8 Else Call Class8User
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then Call Class7 Else Call Class7User
End If
Application.EnableEvents = True
End Sub
I am trying to change the code as below.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call Notify
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call NotifyUser
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call Delta
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call DeltaUser
Application.EnableEvents = True
End If
End If
Application.EnableEvents = True
End Sub

Always indent all your code - then you can easily see where you are missing the end if
Private Sub x(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call notify
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call notifyuser
Application.EnableEvents = True
End If ' <-- This was missing
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call delta
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call deltaUser
Application.EnableEvents = True
End If ' <-- This was missing
End If
Application.EnableEvents = True
End Sub

Microsoft Visual Basic (Checkbox relationships)

I have a problem :)
I am working in Microsoft Word 2013 right now. I made four checkboxes: "A", "B"
, "C" and "D". My wish is that there is a relationship between the checkboxes. So if I check "A" then I want that "B" and "C" are also automatically checked. And if I check "B" I want that "C" is also automatically checked. When I check "C" then I want that just "C" is checked. And if I check "D" then only "D" needs to be checked.
I already found the next code:
Sub SelectAll_Click()
Dim CB As CheckBox
For Each CB In ActiveSheet.CheckBoxes
If CB.Name <> ActiveSheet.CheckBoxes("Check Box 1").Name Then
CB.Value = ActiveSheet.CheckBoxes("Check Box 1").Value
End If
Next CB
End Sub
Sub Mixed_State()
Dim CB As CheckBox
For Each CB In ActiveSheet.CheckBoxes
If CB.Name <> ActiveSheet.CheckBoxes("Check Box 1").Name And CB.Value <> ActiveSheet.CheckBoxes("Check Box 1").Value And ActiveSheet.CheckBoxes("Check Box 1").Value <> 2 Then
ActiveSheet.CheckBoxes("Check Box 1").Value = 2
Exit For
Else
ActiveSheet.CheckBoxes("Check Box 1").Value = CB.Value
End If
Next CB
End Sub
This works for me in Excel, but not in Word (I get an error). But the main issue is that by this code all of the checkboxes are selected. That's not exactly what
I want.
I hope it is clear what I'm asking for and I hope you can help me out.
Thanks!
Kind regards.

Here is the answer (code), for anyone else in the same situation. The checkboxes have a lot of relationships with each other. I have 13 checkboxes.
Private Sub Q1A_Click()
If Q1A.Value = True Then
Q1B.Value = True
Q1C.Value = True
End If
End Sub
Private Sub Q1B_Click()
If Q1B.Value = True Then
Q1C.Value = True
ElseIf Q1B.Value = False Then
Q1A.Value = False
End If
End Sub
Private Sub Q1C_Click()
If Q1C.Value = False Then
Q1B.Value = False
Q1A.Value = False
Q1D.Value = False
End If
End Sub
Private Sub Q1D_Click()
If Q1D.Value = True Then
Q1C.Value = True
End If
End Sub
Private Sub Q1E_Click()
If Q1E.Value = True Then
Q1F.Value = True
Q1G.Value = True
Q1H.Value = True
Q1I.Value = True
Q1J.Value = True
End If
End Sub
Private Sub Q1F_Click()
If Q1F.Value = True Then
Q1G.Value = True
ElseIf Q1F.Value = False Then
Q1E.Value = False
End If
End Sub
Private Sub Q1G_Click()
If Q1G.Value = False Then
Q1F.Value = False
ElseIf Q1G.Value = False Then
Q1E.Value = False
End If
End Sub
Private Sub Q1H_Click()
If Q1H.Value = True Then
Q1I.Value = True
Q1J.Value = True
ElseIf Q1H.Value = False Then
Q1E.Value = False
End If
End Sub
Private Sub Q1I_Click()
If Q1I.Value = True Then
Q1J.Value = True
ElseIf Q1I.Value = False Then
Q1H.Value = False
Q1E.Value = False
End If
End Sub
Private Sub Q1J_Click()
If Q1J.Value = False Then
Q1I.Value = False
Q1H.Value = False
Q1E.Value = False
End If
End Sub
Private Sub Q2A_Click()
If Q2A.Value = True Then
Q2B.Value = True
Q2C.Value = True
End If
End Sub
Private Sub Q2B_Click()
If Q2B.Value = True Then
Q2C.Value = True
ElseIf Q2B.Value = False Then
Q2A.Value = False
End If
End Sub
Private Sub Q2C_Click()
If Q2C.Value = False Then
Q2B.Value = False
Q2A.Value = False
End If
End Sub
Private Sub Q1A_Click()
If Q1A.Value = True Then
Q1B.Value = True
Q1C.Value = True
End If
End Sub
Private Sub Q1B_Click()
If Q1B.Value = True Then
Q1C.Value = True
ElseIf Q1B.Value = False Then
Q1A.Value = False
End If
End Sub
Private Sub Q1C_Click()
If Q1C.Value = False Then
Q1B.Value = False
Q1A.Value = False
Q1D.Value = False
End If
End Sub
Private Sub Q1D_Click()
If Q1D.Value = True Then
Q1C.Value = True
End If
End Sub
Private Sub Q1E_Click()
If Q1E.Value = True Then
Q1F.Value = True
Q1G.Value = True
Q1H.Value = True
Q1I.Value = True
Q1J.Value = True
End If
End Sub
Private Sub Q1F_Click()
If Q1F.Value = True Then
Q1G.Value = True
ElseIf Q1F.Value = False Then
Q1E.Value = False
End If
End Sub
Private Sub Q1G_Click()
If Q1G.Value = False Then
Q1F.Value = False
ElseIf Q1G.Value = False Then
Q1E.Value = False
End If
End Sub
Private Sub Q1H_Click()
If Q1H.Value = True Then
Q1I.Value = True
Q1J.Value = True
ElseIf Q1H.Value = False Then
Q1E.Value = False
End If
End Sub
Private Sub Q1I_Click()
If Q1I.Value = True Then
Q1J.Value = True
ElseIf Q1I.Value = False Then
Q1H.Value = False
Q1E.Value = False
End If
End Sub
Private Sub Q1J_Click()
If Q1J.Value = False Then
Q1I.Value = False
Q1H.Value = False
Q1E.Value = False
End If
End Sub
Private Sub Q2A_Click()
If Q2A.Value = True Then
Q2B.Value = True
Q2C.Value = True
End If
End Sub
Private Sub Q2B_Click()
If Q2B.Value = True Then
Q2C.Value = True
ElseIf Q2B.Value = False Then
Q2A.Value = False
End If
End Sub
Private Sub Q2C_Click()
If Q2C.Value = False Then
Q2B.Value = False
Q2A.Value = False
End If
End Sub

Command Button Code stopped working

I was using this user form code yesterday and everything worked fine. Today, nothing is working. When my command button "Complete" is clicked, the code should verify that the user form is complete (Complete_Enter()) and then transfer the information from the userform to my worksheet. This all worked perfectly yesterday and today it does not. Instead when I click complete, VBA only runs the first line under the Complete_Enter() sub. Here is the code:
Private Sub ConnectorCoverProductionForm_Initialize()
'Empty Serial_NumberTextBox
Serial_Number.Value = ""
Serial_Number.SetFocus
'Empty Order_NumberTextBox
Order_Number.Value = ""
'Empty DateTextBox
TextBox1.Value = ""
Inspector.Clear
Assembler.Clear
Process_Code.Clear
'Uncheck OptionButton
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
OptionButton4.Value = False
OptionButton5.Value = False
OptionButton6.Value = False
OptionButton21.Value = False
OptionButton12.Value = False
OptionButton13.Value = False
OptionButton14.Value = False
OptionButton15.Value = False
OptionButton16.Value = False
End Sub
Private Sub Assembler_DropButtonClick()
Assembler.List = Array("Trung", "Jesus", "Khoi", "Josie", "Omi")
End Sub
Private Sub ClearALL_Click()
Call ConnectorCoverProductionForm_Initialize
End Sub
Private Sub CommandButton1_Click()
Shell ("Explorer \\PC148\Assembly Group\Traveler
End Sub
Private Sub CommandButton2_Click()
Shell ("Explorer \\PC148\Assembly Group\Traveler
End Sub
Private Sub CommandButton3_Click()
Shell ("Explorer \\PC148\Assembly Group\Traveler Templates\Videos\Edited\Mag
End Sub
Private Sub CommandButton4_Click()
Shell ("Explorer \\PC148\Assembly Group\Traveler Templates\Videos\Edited\Mag
End Sub
Private Sub Complete_Click()
Dim emptyRow As Long
Sheet1.Activate
emptyRow = WorksheetFunction.CountA(Range("C:C")) + 1
Cells(emptyRow, 3).Value = Serial_Number.Value
Cells(emptyRow, 4).Value = Order_Number.Value
Cells(emptyRow, 5).Value = TextBox1.Value
Cells(emptyRow, 6).Value = Revision.Value
Cells(emptyRow, 7).Value = Inspector.Value
Cells(emptyRow, 8).Value = Assembler.Value
Cells(emptyRow, 9).Value = Process_Code.Value
If OptionButton1.Value = True Then Cells(emptyRow, 10).Value = OptionButton1.Caption
If OptionButton21.Value = True Then Cells(emptyRow, 10).Value = OptionButton21.Caption
If OptionButton2.Value = True Then Cells(emptyRow, 11).Value = OptionButton2.Caption
If OptionButton12.Value = True Then Cells(emptyRow, 11).Value = OptionButton12.Caption
If OptionButton3.Value = True Then Cells(emptyRow, 12).Value = OptionButton3.Caption
If OptionButton13.Value = True Then Cells(emptyRow, 12).Value = OptionButton13.Caption
If OptionButton4.Value = True Then Cells(emptyRow, 13).Value = OptionButton4.Caption
If OptionButton14.Value = True Then Cells(emptyRow, 13).Value = OptionButton14.Caption
If OptionButton5.Value = True Then Cells(emptyRow, 14).Value = OptionButton5.Caption
If OptionButton15.Value = True Then Cells(emptyRow, 14).Value = OptionButton15.Caption
If OptionButton6.Value = True Then Cells(emptyRow, 15).Value = OptionButton6.Caption
If OptionButton16.Value = True Then Cells(emptyRow, 15).Value = OptionButton16.Caption
End Sub
Private Sub Complete_Enter()
If Serial_Number.Value = "" Then MsgBox "Fill in Serial Number"
Exit Sub
If Order_Number.Value = "" Then MsgBox "Fill in Order Number"
Exit Sub
If TextBox1.Value = "" Then MsgBox "Fill in Date"
Exit Sub
If Revision.Value = "" Then MsgBox "Select the correct Revision"
Exit Sub
If Inspector.Value = "" Then MsgBox "Who was the inspector? If it was you,select 'SELF'"
Exit Sub
If Assembler.Value = "" Then MsgBox "Select Your Name as the Assembler"
Exit Sub
If Process_Code.Value = "" Then MsgBox "Select the correct Process Code"
Exit Sub
If OptionButton1.Value = False And OptionButton21.Value = False Then MsgBox "What is the Status of Step 1"
Exit Sub
If OptionButton2.Value = False And OptionButton12.Value = False Then MsgBox "What is the Status of Step 2"
Exit Sub
If OptionButton3.Value = False And OptionButton13.Value = False Then MsgBox "What is the Status of Step 3"
Exit Sub
If OptionButton4.Value = False And OptionButton14.Value = False Then MsgBox "What is the Status of Step 4"
Exit Sub
If OptionButton5.Value = False And OptionButton15.Value = False Then MsgBox "What is the Status of Step 5"
Exit Sub
If OptionButton6.Value = False And OptionButton16.Value = False Then MsgBox "What is the Status of Step 6"
Exit Sub
End Sub
Private Sub Inspector_DropButtonClick()
Inspector.List = Array("Tom", "Tre", "Omi", "Self")
End Sub
Private Sub Process_Code_DropButtonClick()
Process_Code.List = [index(12*(row(1:12)-1),)]
End Sub
Private Sub Revision_DropButtonClick()
Revision.List = [index(char(64+row(1:26)),)]
End Sub

I expect your routine should be modified like so:
Private Sub Complete_Enter()
If Serial_Number.Value = "" Then
MsgBox "Fill in Serial Number"
ElseIf Order_Number.Value = "" Then
MsgBox "Fill in Order Number"
ElseIf TextBox1.Value = "" Then
MsgBox "Fill in Date"
ElseIf Revision.Value = "" Then
MsgBox "Select the correct Revision"
ElseIf Inspector.Value = "" Then
MsgBox "Who was the inspector? If it was you,select 'SELF'"
ElseIf Assembler.Value = "" Then
MsgBox "Select Your Name as the Assembler"
ElseIf Process_Code.Value = "" Then
MsgBox "Select the correct Process Code"
ElseIf OptionButton1.Value = False And OptionButton21.Value = False Then
MsgBox "What is the Status of Step 1"
ElseIf OptionButton2.Value = False And OptionButton12.Value = False Then
MsgBox "What is the Status of Step 2"
ElseIf OptionButton3.Value = False And OptionButton13.Value = False Then
MsgBox "What is the Status of Step 3"
ElseIf OptionButton4.Value = False And OptionButton14.Value = False Then
MsgBox "What is the Status of Step 4"
ElseIf OptionButton5.Value = False And OptionButton15.Value = False Then
MsgBox "What is the Status of Step 5"
ElseIf OptionButton6.Value = False And OptionButton16.Value = False Then
MsgBox "What is the Status of Step 6"
End If
End Sub