Structure for Multiple Potential Find Errors

Question

I have been writing some code to add to our company's Bill of Materials template Excel file. Every project that we do has its own unique Bill of Materials. I am attempting to make it more dynamic and to add some functionality that it didn't previously have. I have created an add-in BOM MACROS.xlam that each user will add, and stored it on the company network so that I can modify the code and push it out to every file at once. As such, each file will contain the following code within the main worksheet:

'Require all variables to be defined within the sub.
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.Run "'BOM MACROS.xlam'!" & "WorksheetSelectionChange", ActiveWorkbook, ActiveSheet, Target

End Sub

The add-in then contains the following code:

'Require all variables to be defined within the sub.
Option Explicit

Sub WorksheetSelectionChange(wb As Workbook, ws As Worksheet, ByVal Target As Range)
'This sub will run whenever the selection is changed on this sheet. It will
'check if any of the required headings have been deleted and prompt the user to
'add the heading back if it has. It will also check if the selection is in the
'DOC or PO ATTACHMENTS columns and proceed accordingly.

Dim ErrorNo             As Long
Dim HeaderRow           As Long
Dim POAttachmentsColumn As Long
Dim POFilesColumn       As Long
Dim CodeColumn          As Long
Dim QTYColumn           As Long
Dim DescriptionColumn   As Long
Dim CostColumn          As Long
Dim LastRow             As Long
Dim YNAnswer            As Integer
Dim DOCColumn           As Long
Dim Option1Row          As Long
Dim AdderDeductColumn   As Long
Dim OptionTotalRow      As Long
Dim Option1RowCount     As Long
Dim i                   As Long

'Disable screen updating if it is currently enabled.
If Not (Application.ScreenUpdating = False) Then Application.ScreenUpdating = False

'Go to Error_Handling on an error. Check if any of the required headings have been
'deleted. If so, the Find function will throw an error and go to Error_Handling.
'Renumber the ErrorNo variable before each Find so it reflects which heading was deleted.
On Error GoTo Error_Handling
ErrorNo = 1
HeaderRow = ws.Columns(1).Find(What:="ITEM", LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
ErrorNo = 2
LastRow = ws.Columns(1).Find(What:="LAST ROW", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row

If Target.Columns.Count = 1 And Target.Rows.Count = 1 And Target.Row < LastRow Then
    ErrorNo = 3
    POAttachmentsColumn = ws.Rows(HeaderRow).Find(What:="ATTACHMENTS", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 4
    POFilesColumn = ws.Rows(HeaderRow).Find(What:="PO FILES", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 5
    DOCColumn = ws.Rows(HeaderRow).Find(What:="DOC", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 6
    CodeColumn = ws.Rows(HeaderRow).Find(What:="CODE", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 7
    QTYColumn = ws.Rows(HeaderRow).Find(What:="QTY", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 8
    DescriptionColumn = ws.Rows(HeaderRow).Find(What:="DESCRIPTION", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 9
    CostColumn = ws.Rows(HeaderRow).Find(What:="COST", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    ErrorNo = 0

    If Target.Column = POAttachmentsColumn And Target.Row > HeaderRow And Target.Value <> "" Then
    'If the selection is in the POAttachmentsColumn, and it is between the HeaderRow and
    'the LastRow, and only one cell is selected, and the selected cell is not empty, ask
    'the user if they would like to manage the attachments for this item. If so, show the
    'AddLinkForm userform.
        YNAnswer = MsgBox("Would you like to manage the attachments to be added to the PO for this component?", vbYesNo)
        If YNAnswer = vbYes Then
            AddLinkForm.Show
        End If
    ElseIf Target.Column = DOCColumn And Target.Row > HeaderRow And Target.Value = "+" Then
    'If the selection is in the DOCCOlumn, and it is between the HeaderRow and the
    'LastRow, and only one cell is selected, and the cell value is "+", then run
    'the InsertDocumentationRow sub.
        InsertDocumentationRow Target.Row, LastRow
    End If
ElseIf Target.Columns.Count = 1 And Target.Rows.Count = 1 And Target.Row >= LastRow Then
    If Target.Column = 1 And Target.Value = "+ ADD OPTION" Then
        YNAnswer = MsgBox("Would you like to add another option?", vbYesNo)
        If YNAnswer = vbYes Then
            With ws
                ErrorNo = 10
                Option1Row = .Columns(1).Find(What:="OPTION 1", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
                ErrorNo = 11
                AdderDeductColumn = .Rows(Option1Row + 1).Find(What:="ADDER/DEDUCT", LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
                ErrorNo = 12
                OptionTotalRow = .Range(.Cells(Option1Row + 1, AdderDeductColumn), .Cells(Option1Row + 100, AdderDeductColumn)).Find(What:="TOTAL:", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
                ErrorNo = 0
                Option1RowCount = OptionTotalRow - Option1Row + 1
                LastRow = .Cells(.Rows.Count, AdderDeductColumn).End(xlUp).Row
                .Rows(Option1Row & ":" & OptionTotalRow + 1).Copy
                .Rows(LastRow + 2).Insert Shift:=xlDown
                Application.CutCopyMode = False

                .Cells(LastRow + 2, 1).Value = "OPTION " & Right(.Cells(Target.Row, 4), Len(.Cells(Target.Row, 4)) - 14) & " - DESCRIPTION"
                .Cells(LastRow + 2, 1).Characters(Start:=12, Length:=11).Font.Color = -16776961

                If OptionTotalRow - Option1Row > 3 Then
                    For i = LastRow + 1 + Option1RowCount To LastRow + 5 Step -1
                        .Rows(i).Delete
                    Next i
                End If
            End With
        End If
    ElseIf Target.Column = DOCColumn And Target.Row > LastRow And Target.Value = "+ ADD ITEM" Then
        YNAnswer = MsgBox("Would you like to add an item to this option?", vbYesNo)
        If YNAnswer = vbYes Then
            ws.Rows(Target.Row).Copy
            ws.Rows(Target.Row + 1).Insert Shift:=xlDown
            Application.CutCopyMode = False
        End If
    End If
End If

Error_Handling:
'If the Find function fails, check the ErrorNo variable and proceed accordingly.
    If Err.Number = 91 And ErrorNo = 1 Then
        MsgBox "The ""ITEM"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 2 Then
        MsgBox "The last row designator has been deleted. Please put ""LAST ROW"" back in the row under the last BOM item."
    ElseIf Err.Number = 91 And ErrorNo = 3 Then
        MsgBox "The ""ATTACHMENTS"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 4 Then
        MsgBox "The ""PO FILES"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 5 Then
        MsgBox "The ""DOC"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 6 Then
        MsgBox "The ""CODE"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 7 Then
        MsgBox "The ""QTY"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 8 Then
        MsgBox "The ""DESCRIPTION"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 9 Then
        MsgBox "The ""COST"" header has been deleted. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 10 Then
        MsgBox "The ""OPTION 1"" header has been deleted at the bottom of the sheet. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 11 Then
        MsgBox "The ""ADDER/DEDUCT"" header for OPTION 1 has been deleted at the bottom of the sheet. Please put this header back before continuing."
    ElseIf Err.Number = 91 And ErrorNo = 12 Then
        MsgBox "The ""TOTAL:"" cell for OPTION 1 has been deleted at the bottom of the sheet. Please put this header back before continuing."
    ElseIf Err > 0 Then
    'If the error is something else, run the error handler.
        ErrorHandler
    End If

    'If screen updating is disabled, enable it.
    If Not (Application.ScreenUpdating = True) Then Application.ScreenUpdating = True

End Sub

The main function of this code is to check whether certain headings have been deleted. Since the Excel file will be used for many different project types by many different users, I need to make the code as dynamic as possible. As such, I do not have a good way to avoid using the Find function to locate headers for the code. Therefore, if certain headers are deleted, I need to notify the user to add them back.

This code also allows the user to add options at the bottom of the sheet. Each option consists of a few rows with certain headers and formulas that I need to keep consistent for every row in the option, so I want the user to use the code to add lines to the option or to add new options. I also want to avoid using buttons on the sheet. I am considering moving this section of the code to a button on the custom add-in ribbon for this add-in to simplify this section of code.

This code works fine, but I have a feeling that there is a better way to structure the code that captures the Find errors. Any feedback would be appreciated.

Selection changes presumably happen frequently and in volume. You'll want your code to be snappy. Catching a different event may be sufficient, but you could get faster comparisons by using array comparisons, thereby minimizing cell reads. You only need to put the desired column names into an array once and you then only need to check if any column name has changed name or position, and only then do you need to discover which one(s). — ThunderFrame
– ThunderFrame, Commented Jan 19, 2016 at 21:11
So I would need to put the initial column names and relative row and column positions into an array, say on the Workbook_Open event, and then compare that array to the current column names and relative row and column positions on another event? Wouldn't I still need to run each Find command on each event to build the comparison array? Admittedly, I am very much a novice when it comes to working with arrays in VBA. — TheEngineer
– TheEngineer, Commented Jan 19, 2016 at 21:48

Kaz · Accepted Answer · 2016-01-20 16:27:51Z

Just some things that jump out at me:

Integer is outdated. It only exists for backwards-compatibility reasons. The compiler will silently convert them into Long anyway, so just use Long.

YNAnswer should be a Boolean

If not A then A. Why not just A?
Application.ScreenUpdating = False

This:

If Err.Number = 91 And ErrorNo = 1 Then
    MsgBox "The ""ITEM"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 2 Then
    MsgBox "The last row designator has been deleted. Please put ""LAST ROW"" back in the row under the last BOM item."
ElseIf Err.Number = 91 And ErrorNo = 3 Then
    MsgBox "The ""ATTACHMENTS"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 4 Then
    MsgBox "The ""PO FILES"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 5 Then
    MsgBox "The ""DOC"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 6 Then
    MsgBox "The ""CODE"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 7 Then
    MsgBox "The ""QTY"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 8 Then
    MsgBox "The ""DESCRIPTION"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 9 Then
    MsgBox "The ""COST"" header has been deleted. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 10 Then
    MsgBox "The ""OPTION 1"" header has been deleted at the bottom of the sheet. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 11 Then
    MsgBox "The ""ADDER/DEDUCT"" header for OPTION 1 has been deleted at the bottom of the sheet. Please put this header back before continuing."
ElseIf Err.Number = 91 And ErrorNo = 12 Then
    MsgBox "The ""TOTAL:"" cell for OPTION 1 has been deleted at the bottom of the sheet. Please put this header back before continuing."
ElseIf Err > 0 Then
'If the error is something else, run the error handler.
    ErrorHandler
End If

Should be a Select Case statement:

If Err.Number = 91

    Select Case ErrorNo

        Case is = 1
        ...

        Case is = 2
        ...

        Case is = 3
        ...

        Case Else
        ...

    End Select

End If

Repeated strings (or any hardcoded value) should be put in variables:

Dim headerDeletedText as String
headerDeletedText = "header has been deleted. Please put this header back before continuing."

...

ElseIf Err.Number = 91 And ErrorNo = 3 Then
MsgBox "The ""ATTACHMENTS"" " & headerDeletedText

re: integers stackoverflow.com/questions/26409117/… might be a good reference — Raystafarian
– Raystafarian, Commented Jan 20, 2016 at 17:53
Thanks for the feedback! And thanks @Raystafarian for the link. I generally avoid using Integer anyways, so I will change that to a Boolean. Honestly, I'm not sure where I got If Not (Application.ScreenUpdating = True) Then Application.ScreenUpdating = True for this one. I don't use that line in any of my other projects. I'll just set Application.ScreenUpdating = True like I do everywhere else. I'll look into using a Select Case statement in the error section and I will definitely put the repeated strings into variables. — TheEngineer
– TheEngineer, Commented Jan 20, 2016 at 18:04
By the way, I am going to make YNAnswer a Long instead of a Boolean because vbYes = 6 and vbNo = 7. — TheEngineer
– TheEngineer, Commented Jan 20, 2016 at 19:43
@TheEngineer Or, you could use a boolean, which can only be True or False — Kaz
– Kaz, Commented Jan 20, 2016 at 19:44

Community · Accepted Answer · 2017-04-13 12:40:41Z

4

If Not (Application.ScreenUpdating = True) Then Application.ScreenUpdating = True

That is quite ugly. First, don't ever compare a boolean value to a boolean literal - just use the value in the boolean, like this:

If Not (Application.ScreenUpdating) Then Application.ScreenUpdating = True

Next, do you even really need this check? This check is usually only done if the potential changes will potentially cause major updates, like recalculating many values and redrawing the entire screen based on an update. In fact, the only place I usually see checks like this is when updating a field that calls OnNotifyPropertyChanged in C# (which does exactly what I just described). You should probably just assign the value like this:

Application.ScreenUpdating = True

In fact, I would not be surprised if Application.ScreenUpdating did the check internally if the change potentially causes major calculations. My guess is, however, that you are just assigning a flag that other methods check as needed.

Next, check this cool string formatter: A CSharpish String.Format formatting helper. This will help you clean up that massive if case by calculating a couple error-specific values, then outputting with a single output statement.

You don't need to line up the declarations. Some people think it looks neat, I personally do not.

Rubberduck 2.0 (still in development as of this writing) says you don't need to use "" in your comparison, and you should use vbNullString instead.

It also says you never use the parameter wb, and that you should explicitly pass your parameters ByRef. However, because you never assign them, it says you can pass both wb and ws by value. The point about explicitly stating what the modifier is also applies to WorksheetSelectionChange, which is implicitly public.

edited Apr 13, 2017 at 12:40

CommunityBot

1

answered Jan 20, 2016 at 16:23

user34073

\$\begingroup\$ Honestly, I'm not sure where I got If Not (Application.ScreenUpdating = True) Then Application.ScreenUpdating = True for this one. I don't use that line in any of my other projects. I'll just set Application.ScreenUpdating = True like I do everywhere else. I'll check out the string formatter and see if I can implement that to clean this one up. I've written code with the declarations lined up and without and I find it easier for myself to read when they are lined up. Just a personal preference there. \$\endgroup\$

TheEngineer
– TheEngineer

2016-01-20 17:48:49 +00:00
Commented Jan 20, 2016 at 17:48
\$\begingroup\$ vbNullString would be a better way to write that comparison. I'll incorporate that as well, thanks. As for the wb parameter, I realize I am not currently using it, but I want to leave it in. Since the code is stored in an add-in, If I were to decide that I want to use this parameter in the future and I didn't include it, I would either need to go back and edit every file that doesn't have it passed into the Application.Run line for the add-in, or I wouldn't have the added features for all files with the previous version of the code. Thanks for your feedback! \$\endgroup\$

TheEngineer
– TheEngineer

2016-01-20 17:55:35 +00:00
Commented Jan 20, 2016 at 17:55
\$\begingroup\$ OK. Also, you have the If Not line at the beginning of your file to turn ScreenUpdating off. \$\endgroup\$

user34073
– user34073

2016-01-20 18:59:47 +00:00
Commented Jan 20, 2016 at 18:59
\$\begingroup\$ Yeah, I just went through all of the code and changed all the lines where I had that. Thanks! \$\endgroup\$

TheEngineer
– TheEngineer

2016-01-20 19:21:35 +00:00
Commented Jan 20, 2016 at 19:21

Add a comment |

Stack Exchange Network

Structure for Multiple Potential Find Errors

2 Answers 2

You must log in to answer this question.

Linked

Hot Network Questions

Structure for Multiple Potential Find Errors

2 Answers 2

You must log in to answer this question.

Linked

Related

Hot Network Questions