4
\$\begingroup\$

I have a word document which has a lot of active x checkboxes on it and I have just been told the way it has been coded and done could be improved upon a lot, so I am asking for a bit of help.

To quickly explain it, the checkboxes are tied to a "completion overview" at the bottom of the document.

The code on the checkboxes basically when checked, changes a active x label at the bottom to green from red, and changes the text "outstanding" to "completed".

There are also buttons on my word doc which hide certain sections of the document, so when this is done, all checkboxes hidden with it need to have been ticked as they are hidden.

If there are more than one checkbox under a certain header, they all need to be ticked before the list at the bottom will change to green and completed. Here is some code for a 3 checkbox bit, I am sure it can be vastly improved on if not completely changed!

Private Sub UpdateWorkflowSection()
If (WorkflowHasBeenSetupUpCheckBox.Value = True And     RuleSetupCheckBox.Value = True And AddedNewUserCheckBox.Value = True) Then
        Section4Complete.Caption = "Complete": Section4Complete.BackColor = RGB(0, 255, 0): WokflowBy.Caption = UpgradeTechnic.Text
Else
        Section4Complete.Caption = "Outstanding":     Section4Complete.BackColor = RGB(255, 0, 0): WokflowBy.Caption = ""
    End If
End Sub

Here is a dump of all my VBA on this document:

    Private Sub TestingStageHyperLink_Click()
    ActiveDocument.FollowHyperlink "#TESTING STAGE"
    End Sub

    Private Sub CompletionOverviewHyperLink_Click()
    ActiveDocument.FollowHyperlink "#Completion Overview "
    End Sub

    Private Sub Document_Open()
    UpgradeTechnic.List = Array("Tom B", "Liam", "Mat")
    End Sub

Private Sub AllDocumentsPostedCheckbox_Click()
        If (AllDocumentsPostedCheckbox.Value = True) Then
            Section8Complete.Caption = "Complete": Section8Complete.BackColor = RGB(0, 255, 0): DocInputBy.Caption = UpgradeTechnic.Text
        Else
            Section8Complete.Caption = "Outstanding": Section8Complete.BackColor = RGB(255, 0, 0): DocInputBy.Caption = ""
        End If
End Sub

Private Sub ClientTestingCheckBox_Click()
        If (ClientTestingCheckBox.Value = True) Then
            Section11Complete.Caption = "Complete": Section11Complete.BackColor = RGB(0, 255, 0): ClientMachineTestBy.Caption = UpgradeTechnic.Text
        Else
            Section11Complete.Caption = "Outstanding": Section11Complete.BackColor = RGB(255, 0, 0): ClientMachineTestBy.Caption = ""
        End If
End Sub


Private Sub DocumentPrintOutCheckBox_Click()
        If (DocumentPrintOutCheckBox.Value = True) Then
            Section12Complete.Caption = "Complete": Section12Complete.BackColor = RGB(0, 255, 0): DocPrintoutBy.Caption = UpgradeTechnic.Text
        Else
            Section12Complete.Caption = "Outstanding": Section12Complete.BackColor = RGB(255, 0, 0): DocPrintoutBy.Caption = ""
        End If
End Sub

Private Sub ImportCheckBox_Click()
        If (ImportCheckBox.Value = True) Then
            Section10Complete.Caption = "Complete": Section10Complete.BackColor = RGB(0, 255, 0): SysCheckBy.Caption = UpgradeTechnic.Text
        Else
            Section10Complete.Caption = "Outstanding": Section10Complete.BackColor = RGB(255, 0, 0): SysCheckBy.Caption = ""
        End If
End Sub


Private Sub PreReqCheckBox_Click()
        If (PreReqCheckBox.Value = True) Then
        Section1Complete1.Caption = "Complete": Section1Complete1.BackColor = RGB(0, 255, 0): PreReqBy.Caption = UpgradeTechnic.Text
    Else
        Section1Complete1.Caption = "Outstanding": Section1Complete1.BackColor = RGB(255, 0, 0): PreReqBy.Caption = ""
    End If
End Sub

Private Sub DTSCheckBox_Click()
    UpdateChecksAndAmmendmentsSection
End Sub

Private Sub AdminCheckBox_Click()
    UpdateChecksAndAmmendmentsSection
End Sub

Private Sub UpdateChecksAndAmmendmentsSection()
    If (DTSCheckBox.Value = True And AdminCheckBox.Value = True) Then
        Section2Complete.Caption = "Complete": Section2Complete.BackColor = RGB(0, 255, 0): CheckAndAmmendBy.Caption = UpgradeTechnic.Text
    Else
        Section2Complete.Caption = "Outstanding": Section2Complete.BackColor = RGB(255, 0, 0): CheckAndAmmendBy.Caption = ""
    End If

End Sub


Private Sub SetupCheckbox_Click()
        If (SetupCheckbox.Value = True) Then
        Section3Complete.Caption = "Complete": Section3Complete.BackColor = RGB(0, 255, 0): SetupBy.Caption = UpgradeTechnic.Text
    Else
        Section3Complete.Caption = "Outstanding": Section3Complete.BackColor = RGB(255, 0, 0): SetupBy.Caption = ""
    End If

End Sub

Private Sub StandardReportCheckBox_Click()
    If (StandardReportCheckBox.Value = True) Then
        Section13Complete.Caption = "Complete": Section13Complete.BackColor = RGB(0, 255, 0): TestStandardReportsBy.Caption = UpgradeTechnic.Text
    Else
        Section13Complete.Caption = "Outstanding": Section13Complete.BackColor = RGB(255, 0, 0): TestStandardReportsBy.Caption = ""
    End If
End Sub
Private Sub V4ToV6Button_Click()
            ActiveDocument.Sections(2).Range.Font.Hidden = True: ActiveDocument.Sections(4).Range.Font.Hidden = True: ActiveDocument.Sections(6).Range.Font.Hidden = True: ActiveDocument.Sections(8).Range.Font.Hidden = True: ActiveDocument.Sections(10).Range.Font.Hidden = True: Section15Complete.Caption = "": Section15Complete.BackColor = RGB(255, 255, 255): ActiveDocument.Tables(1).Rows(22).SetHeight 1, wdRowHeightExactly: SQLScriptCheckbox.Value = True: SQLScriptCheckbox.Height = 1: SQLScriptCheckbox.Width = 1: SQLScriptCheckbox.Enabled = False: RestoreEmailScriptCheckBox.Value = True: RestoreEmailScriptCheckBox.Height = 1: RestoreEmailScriptCheckBox.Width = 1: RestoreEmailScriptCheckBox.Enabled = False: SQLCleanScriptCheckBox.Value = True: SQLCleanScriptCheckBox.Height = 1: SQLCleanScriptCheckBox.Width = 1: SQLCleanScriptCheckBox.Enabled = False
            SandboxJobHasBeenSetUpCheckBox.Value = True: SandboxJobHasBeenSetUpCheckBox.Width = 1: SandboxJobHasBeenSetUpCheckBox.Height = 1: SandboxJobHasBeenSetUpCheckBox.Enabled = False: LedgerListComplete.Caption = "N/A": LedgerListComplete.BackColor = RGB(139, 0, 139): BankBalanceComplete.Caption = "N/A": BankBalanceComplete.BackColor = RGB(139, 0, 139): BankReconcComplete.Caption = "N/A": BankReconcComplete.BackColor = RGB(139, 0, 139): BudgetComplete.Caption = "N/A": BudgetComplete.BackColor = RGB(139, 0, 139): AllocationComplete.Caption = "N/A": AllocationComplete.BackColor = RGB(139, 0, 139)
            TrialBalanceComplete.Caption = "N/A": TrialBalanceComplete.BackColor = RGB(139, 0, 139): REQSection.Caption = "N/A": REQSection.BackColor = RGB(139, 0, 139)
End Sub

Private Sub V2ToV6Button_Click()

            ActiveDocument.Sections(2).Range.Font.Hidden = False: ActiveDocument.Sections(4).Range.Font.Hidden = False: ActiveDocument.Sections(6).Range.Font.Hidden = False: ActiveDocument.Sections(8).Range.Font.Hidden = False: ActiveDocument.Sections(10).Range.Font.Hidden = False: Section15Complete.Caption = "Outstanding": Section15Complete.BackColor = RGB(255, 0, 0): ActiveDocument.Tables(1).Rows(22).SetHeight Auto, wdRowHeightAuto: SQLScriptCheckbox.Value = False: SQLScriptCheckbox.Width = 151: SQLScriptCheckbox.Height = 42.75: SQLScriptCheckbox.Enabled = True: RestoreEmailScriptCheckBox.Value = False: RestoreEmailScriptCheckBox.Width = 179.75: RestoreEmailScriptCheckBox.Height = 20: RestoreEmailScriptCheckBox.Enabled = True: SQLCleanScriptCheckBox.Value = False: SQLCleanScriptCheckBox.Width = 139.85: SQLCleanScriptCheckBox.Height = 22.85: SQLCleanScriptCheckBox.Enabled = True:
            SandboxJobHasBeenSetUpCheckBox.Value = False: SandboxJobHasBeenSetUpCheckBox.Width = 272.25: SandboxJobHasBeenSetUpCheckBox.Height = 22.85: SandboxJobHasBeenSetUpCheckBox.Enabled = True: LedgerListComplete.Caption = "Outstanding": LedgerListComplete.BackColor = RGB(255, 0, 0): BankBalanceComplete.Caption = "Outstanding": BankBalanceComplete.BackColor = RGB(255, 0, 0): BankReconcComplete.Caption = "Outstanding": BankReconcComplete.BackColor = RGB(255, 0, 0): BudgetComplete.Caption = "Outstanding": BudgetComplete.BackColor = RGB(255, 0, 0): AllocationComplete.Caption = "Outstanding"
            AllocationComplete.BackColor = RGB(255, 0, 0): TrialBalanceComplete.Caption = "Outstanding": TrialBalanceComplete.BackColor = RGB(255, 0, 0): REQSection.Caption = "Outstanding": REQSection.BackColor = RGB(255, 0, 0)
End Sub

Private Sub WorkflowHasBeenSetupUpCheckBox_Click()
    UpdateWorkflowSection
End Sub
Private Sub RuleSetupCheckBox_Click()
    UpdateWorkflowSection
End Sub

Private Sub AddedNewUserCheckBox_Click()
    UpdateWorkflowSection
End Sub
Private Sub UpdateWorkflowSection()
        If (WorkflowHasBeenSetupUpCheckBox.Value = True And RuleSetupCheckBox.Value = True And AddedNewUserCheckBox.Value = True) Then
            Section4Complete.Caption = "Complete": Section4Complete.BackColor = RGB(0, 255, 0): WokflowBy.Caption = UpgradeTechnic.Text
        Else
            Section4Complete.Caption = "Outstanding": Section4Complete.BackColor = RGB(255, 0, 0): WokflowBy.Caption = ""
        End If
End Sub

Private Sub UpdateMPSection()
    If (MPSetupCorrectCheckBox.Value = True And AddedStausCheckBox.Value = True And MPChangesCheckBox.Value = True And MPScriptCheckBox.Value = True) Then
        Section5Complete.Caption = "Completed": Section5Complete.BackColor = RGB(0, 255, 0): MPAmmendBy.Caption = UpgradeTechnic.Text
    Else
        Section5Complete.Caption = "Outstanding": Section5Complete.BackColor = RGB(255, 0, 0): MPAmmendBy.Caption = ""
    End If
End Sub

Private Sub MPSetupCorrectCheckBox_Click()
    UpdateMPSection
End Sub
Private Sub AddedStausCheckBox_Click()
    UpdateMPSection
End Sub
Private Sub MPChangesCheckBox_Click()
    UpdateMPSection
End Sub
Private Sub MPScriptCheckBox_Click()
    UpdateMPSection
End Sub

Private Sub MenuItemsCheckbox_Click()
        If (MenuItemsCheckbox.Value = True) Then
            Section6Complete.Caption = "Complete": Section6Complete.BackColor = RGB(0, 255, 0): MenuItemsBy = UpgradeTechnic.Text
    Else
        Section6Complete.Caption = "Outstanding": Section6Complete.BackColor = RGB(0, 255, 0): MenuItemsBy.Caption = ""
    End If
End Sub

Private Sub UpdateSecurityTestingSection()
    If (VATAndFavCheckBox.Value = True And FixedAsstCheckbox.Value = True And PIAuthorisedCheckbox.Value = True And PBCheckbox.Value = True And DeleteFRCheckBox.Value = True And AuthouriseEmailSentCheckbox.Value = True And C1PostedAndCancels.Value = True And B1AndBXCheckbox.Value = True And PaymentRunCheckBox.Value = True And RemittanceCheckBox.Value = True And SMTPSettingsCheckBox.Value = True And REReportingSettingCheckBox.Value = True And EmailSentCheckBox.Value = True And PurchaseMyLinksCheckbox.Value = True And SalesInvoicePostedCheckBox.Value = True And SalesCreditCheckbox.Value = True And SRAndSXCheckbox.Value = True And SalesMyLinksCheckbox.Value = True And TripsUserFCheckbox.Value = True And NRAndTBCheckbox.Value = True And GJCheckbox.Value = True And VATInPeriodCheckbox.Value = True And VATMyLinksCheckbox.Value = True And SQLScriptCheckbox.Value = True) Then
        Section7Complete.Caption = "Complete": Section7Complete.BackColor = RGB(0, 255, 0): SecurityBy.Caption = UpgradeTechnic.Text
    Else
        Section7Complete.Caption = "Outstanding": Section7Complete.BackColor = RGB(255, 0, 0): SecurityBy.Caption = ""
    End If
End Sub

Private Sub VATAndFavCheckBox_Click()
    UpdateSecurityTestingSection
End Sub

Private Sub FixedAsstCheckBox_Click()
    UpdateSecurityTestingSection
End Sub

Private Sub PIAuthorisedCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub PBCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub DeleteFRCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub AuthouriseEmailSentCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub C1PostedAndCancels_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub B1AndBXCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub PaymentRunCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub RemittanceCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub SMTPSettingsCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub REReportingCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub EmailSentCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub PurchaseMyLinksCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub SalesInvoicePostedCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub SalesCreditCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub SRAndSXCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub SalesMyLinksCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub TripsUserFCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub NRAndTBCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub GJCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub VATInPeriodCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub VATMyLinksCheckbox_Click()
    UpdateSecurityTestingSection
End Sub
Private Sub SQLScriptCheckbox_Click()
    UpdateSecurityTestingSection
End Sub

Private Sub UpdateMyPortalSection()
    If (SearchAndPOINCheckBox.Value = True And PORDCheckBox.Value = True And GRNAndPICheckBox.Value = True) Then
        Section9Complete.Caption = "Complete": Section9Complete.BackColor = RGB(0, 255, 0): MyPortalBy.Caption = UpgradeTechnic.Text
    Else
        Section9Complete.Caption = "Outstanding": Section9Complete.BackColor = RGB(255, 0, 0): MyPortalBy.Caption = ""
    End If
End Sub


Private Sub SearchAndPOINCheckBox_Click()
    UpdateMyPortalSection
End Sub

Private Sub PORDCheckBox_Click()
    UpdateMyPortalSection
End Sub

Private Sub GRNAndPICheckBox_Click()
    UpdateMyPortalSection
End Sub


Private Sub UpdateRequsitionSection()
    If (REQBudgetCheckBox.Value = True And REQHasBeenPostedCheckBox.Value = True And AuthorisedREQCheckBox.Value = True) Then
        REQSection.Caption = "Complete": REQSection.BackColor = RGB(0, 255, 0): REQBy.Caption = UpgradeTechnic.Text
    Else
        REQSection.Caption = "Outstanding": REQSection.BackColor = RGB(255, 0, 0): REQBy.Caption = ""
    End If
End Sub

Private Sub TrialBalanceCheckBox_Click()
    If (TrialBalanceCheckBox.Value = True) Then
        TrialBalanceComplete.Caption = "Complete": TrialBalanceComplete.BackColor = RGB(0, 255, 0): TrialBalanceBy.Caption = UpgradeTechnic.Text
    Else
        TrialBalanceComplete.Caption = "Outstanding": TrialBalanceComplete.BackColor = RGB(255, 0, 0): TrialBalanceBy.Caption = ""
    End If
End Sub

Private Sub LedgerListCheckBox_Click()
    If (LedgerListCheckBox.Value = True) Then
        LedgerListComplete.Caption = "Complete": LedgerListComplete.BackColor = RGB(0, 255, 0): LedgerListBy.Caption = UpgradeTechnic.Text
    Else
        LedgerListComplete.Caption = "Outstanding": LedgerListComplete.BackColor = RGB(255, 0, 0): LedgerListBy.Caption = ""
    End If
End Sub

Private Sub BankBalanceCheckBox_Click()
    If (BankBalanceCheckBox.Value = True) Then
        BankBalanceComplete.Caption = "Complete": BankBalanceComplete.BackColor = RGB(0, 255, 0): BankBalanceBy.Caption = UpgradeTechnic.Text
    Else
        BankBalanceComplete.Caption = "Outstanding": BankBalanceComplete.BackColor = RGB(255, 0, 0): BankBalanceBy.Caption = ""
    End If
End Sub



Private Sub BankReconCheckBox_Click()
    If (BankReconCheckBox.Value = True) Then
        BankReconcComplete.Caption = "Complete": BankReconcComplete.BackColor = RGB(0, 255, 0): BankReconcBy.Caption = UpgradeTechnic.Text
    Else
        BankReconcComplete.Caption = "Outstanding": BankReconcComplete.BackColor = RGB(255, 0, 0): BankReconcBy.Caption = ""
    End If
End Sub

Private Sub BudgetTestingCheckBox_Click()
    If (BudgetTestingCheckBox.Value = True) Then
        BudgetComplete.Caption = "Complete": BudgetComplete.BackColor = RGB(0, 255, 0): BudgetBy.Caption = UpgradeTechnic.Text
    Else
        BudgetComplete.Caption = "Outstanding": BudgetComplete.BackColor = RGB(255, 0, 0): BudgetBy.Caption = ""
    End If
End Sub


Private Sub AllocationCheckBox_Click()
    If (AllocationCheckBox.Value = True) Then
        AllocationComplete.Caption = "Complete": AllocationComplete.BackColor = RGB(0, 255, 0): AllocationBy = UpgradeTechnic.Text
    Else
        AllocationComplete.Caption = "Outstanding": AllocationComplete.BackColor = RGB(255, 0, 0): AllocationBy = ""
    End If
End Sub

Screenshots of the document:

http://imgur.com/a/Bimy4

(Please do not edit this link to show one image only, it goes to an album of 3!)

\$\endgroup\$
  • \$\begingroup\$ Don't use : to combine statements on one line, it makes your code so much harder to read. As an added bonus, there would be no horizontal scrolling in CR because your lines would be shorter. \$\endgroup\$ – FreeMan Oct 20 '16 at 17:03
2
\$\begingroup\$

First of all, kudos for naming all these controls!

You have a lot of duplication going on; extract functionality into more specialized functions/procedures. For example, this:

If (AllDocumentsPostedCheckbox.Value = True) Then
    Section8Complete.Caption = "Complete": Section8Complete.BackColor = RGB(0, 255, 0): DocInputBy.Caption = UpgradeTechnic.Text
Else
    Section8Complete.Caption = "Outstanding": Section8Complete.BackColor = RGB(255, 0, 0): DocInputBy.Caption = ""
End If

Can be generalized/abstracted to:

SetCompletionStatus AllDocumentsPostedCheckbox.Value, Section8Complete

Where SetCompletionStatus could look like this - note the use of VBA.ColorConstants here:

Private Sub SetCompletionStatus(ByVal isCompleted As Boolean, ByVal section As Object)

    Const CompletedColor As Long = VBA.ColorConstants.vbGreen
    Const OutstandingColor As Long = VBA.ColorConstants.vbRed

    section.Caption = IIf(isCompleted, "Complete", "Outstanding")
    section.BackColor = IIf(isCompleted, CompletedColor, OutstandingColor)
    DocInputBy.Caption = IIf(isCompleted, UpgradeTechnic.Text, vbNullString)

End Sub

And all of a sudden every single checkbox handler becomes a one-liner:

Private Sub ClientTestingCheckBox_Click()
    SetCompletionStatus ClientTestingCheckBox.Value, Section11Complete
End Sub

I notice your code contains a lot of instructions separators (:) - as @FreeMan noted, these are doing a great job with making the code harder to read and maintain. It's much easier to see what's going on when a given line of code contains a single instruction.

These two procedures alone are responsible for much of the horizontal scrolling:

Private Sub V4ToV6Button_Click()
            ActiveDocument.Sections(2).Range.Font.Hidden = True: ActiveDocument.Sections(4).Range.Font.Hidden = True: ActiveDocument.Sections(6).Range.Font.Hidden = True: ActiveDocument.Sections(8).Range.Font.Hidden = True: ActiveDocument.Sections(10).Range.Font.Hidden = True: Section15Complete.Caption = "": Section15Complete.BackColor = RGB(255, 255, 255): ActiveDocument.Tables(1).Rows(22).SetHeight 1, wdRowHeightExactly: SQLScriptCheckbox.Value = True: SQLScriptCheckbox.Height = 1: SQLScriptCheckbox.Width = 1: SQLScriptCheckbox.Enabled = False: RestoreEmailScriptCheckBox.Value = True: RestoreEmailScriptCheckBox.Height = 1: RestoreEmailScriptCheckBox.Width = 1: RestoreEmailScriptCheckBox.Enabled = False: SQLCleanScriptCheckBox.Value = True: SQLCleanScriptCheckBox.Height = 1: SQLCleanScriptCheckBox.Width = 1: SQLCleanScriptCheckBox.Enabled = False
            SandboxJobHasBeenSetUpCheckBox.Value = True: SandboxJobHasBeenSetUpCheckBox.Width = 1: SandboxJobHasBeenSetUpCheckBox.Height = 1: SandboxJobHasBeenSetUpCheckBox.Enabled = False: LedgerListComplete.Caption = "N/A": LedgerListComplete.BackColor = RGB(139, 0, 139): BankBalanceComplete.Caption = "N/A": BankBalanceComplete.BackColor = RGB(139, 0, 139): BankReconcComplete.Caption = "N/A": BankReconcComplete.BackColor = RGB(139, 0, 139): BudgetComplete.Caption = "N/A": BudgetComplete.BackColor = RGB(139, 0, 139): AllocationComplete.Caption = "N/A": AllocationComplete.BackColor = RGB(139, 0, 139)
            TrialBalanceComplete.Caption = "N/A": TrialBalanceComplete.BackColor = RGB(139, 0, 139): REQSection.Caption = "N/A": REQSection.BackColor = RGB(139, 0, 139)
End Sub

Private Sub V2ToV6Button_Click()

            ActiveDocument.Sections(2).Range.Font.Hidden = False: ActiveDocument.Sections(4).Range.Font.Hidden = False: ActiveDocument.Sections(6).Range.Font.Hidden = False: ActiveDocument.Sections(8).Range.Font.Hidden = False: ActiveDocument.Sections(10).Range.Font.Hidden = False: Section15Complete.Caption = "Outstanding": Section15Complete.BackColor = RGB(255, 0, 0): ActiveDocument.Tables(1).Rows(22).SetHeight Auto, wdRowHeightAuto: SQLScriptCheckbox.Value = False: SQLScriptCheckbox.Width = 151: SQLScriptCheckbox.Height = 42.75: SQLScriptCheckbox.Enabled = True: RestoreEmailScriptCheckBox.Value = False: RestoreEmailScriptCheckBox.Width = 179.75: RestoreEmailScriptCheckBox.Height = 20: RestoreEmailScriptCheckBox.Enabled = True: SQLCleanScriptCheckBox.Value = False: SQLCleanScriptCheckBox.Width = 139.85: SQLCleanScriptCheckBox.Height = 22.85: SQLCleanScriptCheckBox.Enabled = True:
            SandboxJobHasBeenSetUpCheckBox.Value = False: SandboxJobHasBeenSetUpCheckBox.Width = 272.25: SandboxJobHasBeenSetUpCheckBox.Height = 22.85: SandboxJobHasBeenSetUpCheckBox.Enabled = True: LedgerListComplete.Caption = "Outstanding": LedgerListComplete.BackColor = RGB(255, 0, 0): BankBalanceComplete.Caption = "Outstanding": BankBalanceComplete.BackColor = RGB(255, 0, 0): BankReconcComplete.Caption = "Outstanding": BankReconcComplete.BackColor = RGB(255, 0, 0): BudgetComplete.Caption = "Outstanding": BudgetComplete.BackColor = RGB(255, 0, 0): AllocationComplete.Caption = "Outstanding"
            AllocationComplete.BackColor = RGB(255, 0, 0): TrialBalanceComplete.Caption = "Outstanding": TrialBalanceComplete.BackColor = RGB(255, 0, 0): REQSection.Caption = "Outstanding": REQSection.BackColor = RGB(255, 0, 0)
End Sub

Compare to:

Private Sub V4ToV6Button_Click()
    ActiveDocument.Sections(2).Range.Font.Hidden = True
    ActiveDocument.Sections(4).Range.Font.Hidden = True
    ActiveDocument.Sections(6).Range.Font.Hidden = True
    ActiveDocument.Sections(8).Range.Font.Hidden = True
    ActiveDocument.Sections(10).Range.Font.Hidden = True
    Section15Complete.Caption = ""
    Section15Complete.BackColor = RGB(255, 255, 255)
    ActiveDocument.Tables(1).Rows(22).SetHeight 1, wdRowHeightExactly
    SQLScriptCheckbox.Value = True
    SQLScriptCheckbox.Height = 1
    SQLScriptCheckbox.Width = 1
    SQLScriptCheckbox.Enabled = False
    RestoreEmailScriptCheckBox.Value = True
    RestoreEmailScriptCheckBox.Height = 1
    RestoreEmailScriptCheckBox.Width = 1
    RestoreEmailScriptCheckBox.Enabled = False
    SQLCleanScriptCheckBox.Value = True
    SQLCleanScriptCheckBox.Height = 1
    SQLCleanScriptCheckBox.Width = 1
    SQLCleanScriptCheckBox.Enabled = False
    SandboxJobHasBeenSetUpCheckBox.Value = True
    SandboxJobHasBeenSetUpCheckBox.Width = 1
    SandboxJobHasBeenSetUpCheckBox.Height = 1
    SandboxJobHasBeenSetUpCheckBox.Enabled = False
    LedgerListComplete.Caption = "N/A"
    LedgerListComplete.BackColor = RGB(139, 0, 139)
    BankBalanceComplete.Caption = "N/A"
    BankBalanceComplete.BackColor = RGB(139, 0, 139)
    BankReconcComplete.Caption = "N/A"
    BankReconcComplete.BackColor = RGB(139, 0, 139)
    BudgetComplete.Caption = "N/A"
    BudgetComplete.BackColor = RGB(139, 0, 139)
    AllocationComplete.Caption = "N/A"
    AllocationComplete.BackColor = RGB(139, 0, 139)
    TrialBalanceComplete.Caption = "N/A"
    TrialBalanceComplete.BackColor = RGB(139, 0, 139)
    REQSection.Caption = "N/A"
    REQSection.BackColor = RGB(139, 0, 139)
End Sub

Now, you can see that there's perhaps room for some Const DefaultColor As Long = RGB(139, 0, 139)... and then perhaps procedures could be extracted to reduce redundancies again, but I believe ActiveDocument might be an eventual problem here - it's probably best to refer to ThisDocument instead, since the active document might be anything else opened in MS-Word.

Cramming all these instructions into a single line is actually indecent, impractical and even dishonest: if makes the procedure look smaller than it really is if you're just quickly scrolling through the module.

\$\endgroup\$
  • \$\begingroup\$ Only problem i am seeing with this is, on some sections, there are more than one checkbox. \$\endgroup\$ – Steve101 Oct 24 '16 at 10:10
  • \$\begingroup\$ So sometimes i need to have the code basiclly say, only complete the section when all of these check boxes are ticked, how do i do that with the style of vba you gave me for doing the checkboxes? \$\endgroup\$ – Steve101 Oct 24 '16 at 10:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.