HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Word VBA Code to Automate Table Captioning

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
automatecaptioningwordvbacodetable

Problem

I have a Word VBA script that auto-generates a table caption based on user input & a previous heading. Its purpose is to speed up editing & formatting of massive software documents (like the 1000+ page test procedure I'm currently reviewing). At this point, it's slightly quicker than scrolling back up, copying the heading manually, creating a caption, and pasting it in, but it lags a little. So, I'm looking for advice on optimizing & speeding it up.

I should note that this is only for my use (which might be obvious by the less than serious user prompts) and that I'm a tech writer who dabbles in VBA, rather than someone with a programming background.

Here's the script itself:

Sub TestTableCaption()

Dim strCaption As String
Dim intTableType As Integer
Dim strTableType As String

strTableType = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
intTableType = Val(strTableType)

Select Case intTableType

Case 1
    strTableType = "Test Requirements Matrix"

Case 2
    strTableType = "Test Status"
Case 3
    strTableType = "Test Steps"
Case Else
    strTableType = ""
    MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
    Exit Sub

End Select

strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")

strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, "  ", " ")
'In theory, Gets rid of dash from title. Doesn't actually work.

'MsgBox (strCaption)
Call GenerateCaption(strCaption, "Table")
End Sub


And here's the FindHeading function:

```
Function FindHeading(strHeadLevel As String) As String
'Gets the heading level as an input and finds the closest heading of that level before the selection.

Dim rngSelection As Range
'the initial selection

Dim rngPrev As Range
'The current paragraph to be evaluated.

Set rngSelection = Selection.Range

Set rngPrev = rngSelection.Previous(wdParagraph, 1)

'MsgBox (rngPrev.Text)

Solution

Clean everything up

Code should be written for other people (including future you) to read and understand. A key aspect of this is using consistent rules and conventions for laying out your code.

Indent logic levels, put comments on the same line as the thing being commented (where feasible), use whitespace liberally and consistently.

Same code, much easier to "see", at a glance, what's going on:

Public Sub TestTableCaption()

    Dim strTableType As String
    strTableType = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")

    Dim intTableType As Integer
    intTableType = Val(strTableType)
    Select Case intTableType

        Case 1
            strTableType = "Test Requirements Matrix"
        Case 2
            strTableType = "Test Status"
        Case 3
            strTableType = "Test Steps"
        Case Else
            strTableType = ""
            MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
            Exit Sub

    End Select

    strCaption = FindHeading("Heading 3") & " " & strTableType
    strCaption = Replace(strCaption, vbCr, "")
    strCaption = Replace(strCaption, Chr(150), "")
    strCaption = Replace(strCaption, "  ", " ")
    'In theory, Gets rid of dash from title. Doesn't actually work.

    'MsgBox (strCaption)
    Call GenerateCaption(strCaption, "Table")

End Sub


And now we can immediately see that your sub has 4 distinct sub-sections:

  • Get user input number



  • Convert number to the appropriate table style



  • Find the relevant table heading and clean the text a bit



  • Call GenerateCaption with the (now cleaned) caption text.



This leads us to the next key idea:

Refactor Mercilessly

Refactoring is the process of taking some set of operations, and abstracting them into their own Sub/Function. This makes your code cleaner, easier to follow, easier to modify and more re-usable.

Let's take this a step at a time.

Step 1: Get the user input string.

What are our requirements? The user needs to indicate which of 3 table types to change by inputting a number from 1 to 3.

First, a Descriptive, Unambiguous, name:

Public Function TypenumFromUser() As Long


Second, get input.

Dim userInput As String
    userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")


Third, validate Input. Input must be a number. And it must be 1, 2 or 3. If the input is invalid, let's prompt the user to try again.

Public Function TypenumFromUser() As Long
    '/ User must input a table type as a number
    '/ Current options are 1, 2 or 3
    '/ If the input is invalid, prompt the user to try again

GetNewInput:
    Dim userInput As String
    userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")

    Dim intCheck As Long
    On Error GoTo BadUserInput
        intCheck = CLng(userInput)
    On Error GoTo 0

    Dim isValidInput As Boolean
    isValidInput = False
    If IsWholeNumber(intCheck) Then
        If intCheck >= 1 And intCheck <= 3 Then
            isValidInput = True
        End If
    End If

    If isValidInput Then
        TypenumFromUser= intCheck
    Else
        GoTo BadUserInput
    End If

CleanExit:
    Exit Function

BadUserInput:
    MsgBox "Input must be a whole number from 1 to 3. Please try again."
    GoTo GetNewInput

End Function

Public Function IsWholeNumber(ByVal checkNum As Variant) As Boolean
    '/ First check that input is a number.
    '/ Then round to the nearest whole number.
    '/ If the rounded number is the original number, then it is a whole number

    IsWholeNumber = False
    If IsNumeric(checkNum) And (Math.Round(checkNum, 0) = checkNum) Then
        IsWholeNumber = True
    End If

End Function


Sure, it's a bit verbose, but now you never need to touch this function again. And if your inputs change, you know exactly where to go to change things.

You've also now got an IsWholeNumber function which you can use in other projects down the line. You should build these utility function up over time and before long, you'l have a whole module full of useful little functions that you can import into any new project.

Now, your sub looks like this:

```
Public Sub TestTableCaption()

Dim intTableType As String
intTableType = TypenumFromUser
Select Case intTableType

Case 1
strTableType = "Test Requirements Matrix"
Case 2
strTableType = "Test Status"
Case 3
strTableType = "Test Steps"
Case Else
strTableType = ""
MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
Exit Sub

End Select

strCaption = FindHeading("Heading 3") & " " & strTableType
strCaption = Replace(strCaption, vbCr, "")
strCaption = Replace(strCaption, Chr(150), "")
strCaption = Replace(strCaption, " ", " ")
'In theory, Gets

Code Snippets

Public Sub TestTableCaption()


    Dim strTableType As String
    strTableType = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")

    Dim intTableType As Integer
    intTableType = Val(strTableType)
    Select Case intTableType

        Case 1
            strTableType = "Test Requirements Matrix"
        Case 2
            strTableType = "Test Status"
        Case 3
            strTableType = "Test Steps"
        Case Else
            strTableType = ""
            MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
            Exit Sub

    End Select

    strCaption = FindHeading("Heading 3") & " " & strTableType
    strCaption = Replace(strCaption, vbCr, "")
    strCaption = Replace(strCaption, Chr(150), "")
    strCaption = Replace(strCaption, "  ", " ")
    'In theory, Gets rid of dash from title. Doesn't actually work.

    'MsgBox (strCaption)
    Call GenerateCaption(strCaption, "Table")

End Sub
Public Function TypenumFromUser() As Long
Dim userInput As String
    userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")
Public Function TypenumFromUser() As Long
    '/ User must input a table type as a number
    '/ Current options are 1, 2 or 3
    '/ If the input is invalid, prompt the user to try again

GetNewInput:
    Dim userInput As String
    userInput = InputBox("Enter 1 for Test Requirements Matrix, 2 for Test Status, or 3 for Test Steps")

    Dim intCheck As Long
    On Error GoTo BadUserInput
        intCheck = CLng(userInput)
    On Error GoTo 0

    Dim isValidInput As Boolean
    isValidInput = False
    If IsWholeNumber(intCheck) Then
        If intCheck >= 1 And intCheck <= 3 Then
            isValidInput = True
        End If
    End If

    If isValidInput Then
        TypenumFromUser= intCheck
    Else
        GoTo BadUserInput
    End If

CleanExit:
    Exit Function

BadUserInput:
    MsgBox "Input must be a whole number from 1 to 3. Please try again."
    GoTo GetNewInput

End Function

Public Function IsWholeNumber(ByVal checkNum As Variant) As Boolean
    '/ First check that input is a number.
    '/ Then round to the nearest whole number.
    '/ If the rounded number is the original number, then it is a whole number

    IsWholeNumber = False
    If IsNumeric(checkNum) And (Math.Round(checkNum, 0) = checkNum) Then
        IsWholeNumber = True
    End If

End Function
Public Sub TestTableCaption()

    Dim intTableType As String
    intTableType = TypenumFromUser
    Select Case intTableType

        Case 1
            strTableType = "Test Requirements Matrix"
        Case 2
            strTableType = "Test Status"
        Case 3
            strTableType = "Test Steps"
        Case Else
            strTableType = ""
            MsgBox ("Entry needs to be 1, 2, or 3. Learn to follow directions, then try again.")
            Exit Sub

    End Select

    strCaption = FindHeading("Heading 3") & " " & strTableType
    strCaption = Replace(strCaption, vbCr, "")
    strCaption = Replace(strCaption, Chr(150), "")
    strCaption = Replace(strCaption, "  ", " ")
    'In theory, Gets rid of dash from title. Doesn't actually work.

    'MsgBox (strCaption)
    Call GenerateCaption(strCaption, "Table")

End Sub

Context

StackExchange Code Review Q#134574, answer score: 4

Revisions (0)

No revisions yet.