2
\$\begingroup\$

I've written some code in Excel VBA that does the following:

  • Finds a cell ("O") in a range (C3 to Z26)
  • Looks at an adjacent cell. This cell is located through "OFFSET_ROW" and "OFFSET_COLUMN" (defined in a separate public variable) and contains a text string that is split into an array (using the "\" character as a delimiter)
  • Then, based on values in this array (e.g. "-100"), either:
    • Changes the values in two other "sets" of cells:
      • Set 1: Four cells in one sheet ("DISP_SHEET")
      • Set 2: Four cells in another sheet ("DIR_SHEET")
    • Or, if changing the Set 1 and Set 2 cell values would result in any of them going below 0, shows a message box.

NB: The exact changes made to the sets of cells are dependent on whether the 19th array value ("ARR(18)") is 0 or something else.

Here's the code:

Private Sub optChoice1_Click()

    Dim O As Range
    Dim DISP_SHEET As Worksheet
    Dim DIR_SHEET As Worksheet
    Dim TEXT As String
    Dim ARR() As String
    Dim X As Integer

    'Set the range (Sheet1, C3 to Z26) in which to search for "O")
    Set O = Sheet1.Range("C3:Z26").Find(WHAT:="O", LookAt:=xlWhole, MatchCase:=True)
    Set DISP_SHEET = Sheet1
    Set DIR_SHEET = Sheet4

    TEXT = O.Offset(OFFSET_ROW, OFFSET_COLUMN)
    ARR = Split(TEXT, "\")

    'If the 19th array value is 0...
    If ARR(18) = 0 Then
        'If enacting the choice wouldn't make any of the Set 1 or Set 2 cell values go below 0...
        If _
        DISP_SHEET.Range(ARR(14)).Value + ARR(20) >= 0 And _
        DISP_SHEET.Range(ARR(15)).Value + ARR(21) >= 0 And _
        DISP_SHEET.Range(ARR(16)).Value + ARR(22) >= 0 And _
        DISP_SHEET.Range(ARR(17)).Value + ARR(23) >= 0 And _
        DIR_SHEET.Range(ARR(134)).Value + ARR(24) >= 0 And _
        DIR_SHEET.Range(ARR(135)).Value + ARR(25) >= 0 And _
        DIR_SHEET.Range(ARR(136)).Value + ARR(26) >= 0 And _
        DIR_SHEET.Range(ARR(137)).Value + ARR(27) >= 0 Then
            'Show the message in ARR(19)
            MsgBox ARR(19)
            For X = 0 To 3
                'Enact the changes on the four Set 1 cells
                DISP_SHEET.Range(ARR(X + 14)).Value = DISP_SHEET.Range(ARR(X + 14)).Value + ARR(X + 20)
                'Enact the changes on the four Set 2 cells
                DIR_SHEET.Range(ARR(X + 134)).Value = DIR_SHEET.Range(ARR(X + 134)).Value + ARR(X + 24)
            Next X
        'Otherwise, if enacting the choice would make one or more of the Set 2 cell values below 0.
        ElseIf _
        DIR_SHEET.Range(ARR(134)).Value + ARR(24) < 0 Or _
        DIR_SHEET.Range(ARR(135)).Value + ARR(25) < 0 Or _
        DIR_SHEET.Range(ARR(136)).Value + ARR(26) < 0 Or _
        DIR_SHEET.Range(ARR(137)).Value + ARR(27) < 0 Then
            'Show the message in ARR(138)
            '(This states that the choice cannot be made because one or more of the Set 2 cell values would go below 0.)
            MsgBox ARR(138)
        Else
            'Otherwise show the message in ARR(139)
            '(This states that the choice cannot be made because one or more of the Set 1 cell values would go below 0.)
            MsgBox ARR(139)
        End If

    'Otherwise (if the 19th array value isn't 0)
    Else
        If _
        DISP_SHEET.Range(ARR(14)).Value + ARR(38) >= 0 And _
        DISP_SHEET.Range(ARR(15)).Value + ARR(39) >= 0 And _
        DISP_SHEET.Range(ARR(16)).Value + ARR(40) >= 0 And _
        DISP_SHEET.Range(ARR(17)).Value + ARR(41) >= 0 And _
        DIR_SHEET.Range(ARR(134)).Value + ARR(42) >= 0 And _
        DIR_SHEET.Range(ARR(135)).Value + ARR(43) >= 0 And _
        DIR_SHEET.Range(ARR(136)).Value + ARR(44) >= 0 And _
        DIR_SHEET.Range(ARR(137)).Value + ARR(45) >= 0 Then
            MsgBox ARR(37)
            For X = 0 To 3
                DISP_SHEET.Range(ARR(X + 14)).Value = DISP_SHEET.Range(ARR(X + 14)).Value + ARR(X + 38)
                DIR_SHEET.Range(ARR(X + 134)).Value = DIR_SHEET.Range(ARR(X + 134)).Value + ARR(X + 42)
            Next X
        ElseIf _
        DIR_SHEET.Range(ARR(134)).Value + ARR(42) < 0 And _
        DIR_SHEET.Range(ARR(135)).Value + ARR(43) < 0 And _
        DIR_SHEET.Range(ARR(136)).Value + ARR(44) < 0 And _
        DIR_SHEET.Range(ARR(137)).Value + ARR(45) < 0 Then
            MsgBox ARR(138)
        Else
            MsgBox ARR(139)
        End If
    End If

End Sub

As you can see, there's a fair amount of repetition in the lines beginning "DISP_SHEET.Range" or "DIR_SHEET.Range". I've tried to implement some sort of loop here but haven't had much luck.

I'm having difficulties here, probably because:

  • All of the conditions have to be true (e.g. in order to enact the changes, all of the values have to remain above 0).
  • The changes have to take place across two different sheets.
  • There is already another loop that exists in my code (using "X").

It's probably a simple solution but I'm getting confused trying to balance these three things. Any help improving this or clearing it up would be much appreciated.

\$\endgroup\$
  • 1
    \$\begingroup\$ Two things that pop out at me: 1) the unqualified Range items are referring to the active worksheet; suggest you explicitly qualify which sheet. 2) your comment says "If the 18th array value..." ARR(18) is the 19th value - ARR is a zero-based array IIRC. \$\endgroup\$ – SmileyFtW Dec 27 '19 at 17:13
  • \$\begingroup\$ Thank you - both very good points. I've made the edits above. \$\endgroup\$ – Antony Dec 27 '19 at 18:25
  • \$\begingroup\$ Providing example data will yield better reviews. Can you provide sample text so that we can split it and see what ARR() does? It seems like some parts of ARR() contain cell references while other parts contain values. What is the logic behind the pattern? Why are elements 14-17,134-137 address and 20-27 values? \$\endgroup\$ – TinMan Dec 28 '19 at 15:51
4
\$\begingroup\$

Qualify your variables. I read your post and after copying/pasting the code I created a standard module named GlobalVariables so that I had O.Offset(GlobalVariables.OFFSET_ROW, GlobalVariables.OFFSET_COLUMN) that identified where those variables came from. This helps future-you or another coder reading your know where things are located.

Your wall of declarations at the top can be removed. I prefer having my variables declared just before their use. This aids in refactoring later and helps eliminate variables that are no longer being used. If left at the top it's not immediately apparent when a variable is no longer being referenced.

Dim sourceArea As Range
Set sourceArea as = InputSheet.Range("InputArea")

No need to yell. IE your variables are in SCEAM_CASE. Convention in VBA usually has variables in camel casing as in worksheetThatHasSourceInformation where the first variables letter is lowercased and the first letter thereafter of each new word is upper cased. Pascal case is used for Subs/Function and members of a class module.

Use of _ (underscores) in variable names. Using an underscore is how the Implements statement handles when an interface is implemented. InterfaceName_Member is the eventual syntax. Reserve underscores for when that keyword is used to make it easier to learn when you start implementing interfaces.

Compile time references. You have Set dispSheet = Sheet1 and set dirSheet = Sheet4. No need to do that. Instead rename the Worksheet.CodeName property of those worksheet objects by right clicking on the variable Sheet1 or Sheet4 in the IDE and, from the context menu, choosing Definition. That will take you to the code behind of that worksheet. From the menu at the top choose View>Properties Window (Hotkey: F4) and renaming the (Name) property to a descriptive name. That leads to the next item for review.

We've all been there. Naming is hard at best. Use descriptive variable names. O is a letter. O by itself doesn't help me understand what it's representing. An excessively long-winded name could be firstCellOnTheSearchedSheetFoundToContainTheLetterO and it a lot more helpful stating what that variable's there for. In the absence of understanding what that "O" searched for represents that's the best I can name it. The same goes for dispWorkSheet, ¿displayWorksheetSheet?, or dirWorkSheet, ¿directorySheet?, are not descriptive either. Future-you will thank you for giving your variables descriptive names so that 6months+ when you come back to it you're not head scratching over what they mean.

Variable reuse: it's like trying to reuse toilet paper. Don't. You're using X in two different locations. Rename X and create a new descriptively named variable where you use it again below. This helps prevent accidental cross-contamination.

The use of Integer when X is declared can be replaced with Long. You're less likely to have an overflow and IIRC internally a Long is used.

Static cell address. Range("C3:Z26") is a ticking time bomb waiting to go off. You add a row above row 3 or a column in front of column C and BARF the code is no longer searching within where you wanted it to. Use a named range. From Excel under the Formulas tab>Defined Names group>Name Manager button will display the Name Manager dialog. Click the New button to display the New Name dialog window. Enter in a name for that range, limit the scope to dispWorksheet (Renamed from Sheet1). Now you search within that range with dispWorksheet.Names("AdequatelyNamedRange").RefersToRange.Find(...). Adding a row/column will no longer adversely affect where you're searching. The same is true for deleted row/column in the named range.

Magic numbers. 14, 15, 16, 17, etc... What do those numbers mean, why are they there. A Const DescriptiveVaribleNameFor14 as long = 14 will aide to make the code self documenting.

IMO The use of MsgBox can be removed. The reason for this is that you're providing information to the user without a way for them to abort.

As you code becomes self documenting it becomes a lot clearer what's going on.


Above were the easier issues to address. What remains requires in depth refactoring to increase the abstraction level. As the abstraction increases the code should be a lot more readable.

The boolean checks are checking both dispWorksheet and dirWorksheet and that feels odd. I suggest separating them into their own individual appropriately named properties for each worksheet. Once you have that it should become simpler to tease apart what you're doing.

Warning: This is air coding and is only to give an idea as to how to proceed. Variable names are ludicrous but also help to show what is implicitly being done because of the static numbers.

'Module1
Private Sub optChoice1_Click()
    Dim ARR() As String
    If dispWorksheet.NineteenthElementInArrayContainsAZero("O", "\", ARR) Then
        If dispWorksheet.Values14Through17Plus20Through23AreGreaterThanZero(ARR) _
        And dirWorksheet.Values134Through137Plus24Through27AreGreaterThanZero(ARR) Then
            MsgBox ARR(19)
            dispWorksheet.UpdateValuesForSet1Using20Through23 ARR
            dirWorksheet.UpdateValuesForSet2Using24Through27 ARR
        ElseIf dirWorksheet.Values134Through137Plus24Through27AreGreaterThanZero(ARR) Then
            MsgBox ARR(138)
        Else
            MsgBox ARR(139)
        End If
    Else
        If dispWorksheet.Values14Through17Plus38Through41AreGreaterThanZero(ARR) _
        And dirWorksheet.Values134Through137Plus42Through45AreGreaterThanZero(ARR) Then
            MsgBox ARR(37)
            dispWorksheet.UpdateValuesForSet1Using38Through41 ARR
            dirWorksheet.UpdateValuesForSet2Using42Through45 ARR
        ElseIf dirWorksheet.Values134Through137Plus42Through45AreGreaterThanZero(ARR) Then
            MsgBox ARR(138)
        Else
            MsgBox ARR(139)
        End If
    End If
End Sub

The user defined worksheet properties

'dirWorksheet
Public Function Values134Through137Plus24Through27AreGreaterThanZero(ByRef splitArray() As String) As Boolean
    Values134Through137Plus24Through27AreGreaterThanZero = Me.Range(splitArray(134)).Value + splitArray(24) >= 0 _
                                                            And Me.Range(splitArray(135)).Value + splitArray(25) >= 0 _
                                                            And Me.Range(splitArray(136)).Value + splitArray(26) >= 0 _
                                                            And Me.Range(splitArray(137)).Value + splitArray(27) >= 0
End Function

Public Function Values134Through137Plus42Through45AreGreaterThanZero(ByRef splitArray() As String) As Boolean
    Values134Through137Plus42Through45AreGreaterThanZero = Me.Range(splitArray(134)).Value + splitArray(42) >= 0 _
                                                            And Me.Range(splitArray(135)).Value + splitArray(43) >= 0 _
                                                            And Me.Range(splitArray(136)).Value + splitArray(44) >= 0 _
                                                            And Me.Range(splitArray(137)).Value + splitArray(45) >= 0
End Function

Public Sub UpdateValuesForSet2Using24Through27(ByRef splitArray() As String)
    Dim counter As Long
    For counter = 0 To 3
        dirWorksheet.Range(splitArray(counter + 134)).Value = dirWorksheet.Range(splitArray(counter + 134)).Value + splitArray(counter + 24)
    Next counter
End Sub

Public Sub UpdateValuesForSet2Using42Through45(ByRef splitArray() As String)
    Dim counter As Long
    For counter = 0 To 3
        dirWorksheet.Range(splitArray(counter + 134)).Value = dirWorksheet.Range(splitArray(counter + 134)).Value + splitArray(counter + 42)
    Next
End Sub

and

'dispWorksheet
Public Function NineteenthElementInArrayContainsAZero(ByVal searchCharacter As String, _
                                                                ByRef delimitingCharacter As String, _
                                                                ByRef outArrayValues() As String) As Boolean
    Dim firstCellOnTheSearchedSheetFoundToContainTheLetterO As Range
    Set firstCellOnTheSearchedSheetFoundToContainTheLetterO = AdequatelyNamedRange.Find(WHAT:=searchCharacter, LookAt:=xlWhole, MatchCase:=True)

    Dim valueToSplit As String
    valueToSplit = firstCellOnTheSearchedSheetFoundToContainTheLetterO.Offset(PublicVariables.OFFSET_ROW, PublicVariables.OFFSET_COLUMN).Value2
    outArrayValues = Split(valueToSplit, delimitingCharacter)
End Function

Private Property Get AdequatelyNamedRange() As Range
    Set AdequatelyNamedRange = Me.Names("AdequatelyNamedRange").RefersToRange
End Property


Public Function Values14Through17Plus20Through23AreGreaterThanZero(ByRef splitArray() As String) As Boolean
    Values14Through17Plus20Through23AreGreaterThanZero = Me.Range(splitArray(14)).Value + splitArray(20) >= 0 _
                                                        And Me.Range(splitArray(15)).Value + splitArray(21) >= 0 _
                                                        And Me.Range(splitArray(16)).Value + splitArray(22) >= 0 _
                                                        And Me.Range(splitArray(17)).Value + splitArray(23) >= 0
End Function

Public Function Values14Through17Plus38Through41AreGreaterThanZero(ByRef splitArray() As String) As Boolean
    Values14Through17Plus38Through41AreGreaterThanZero = Me.Range(splitArray(14)).Value + splitArray(38) >= 0 _
                                                        And Me.Range(splitArray(15)).Value + splitArray(39) >= 0 _
                                                        And Me.Range(splitArray(16)).Value + splitArray(40) >= 0 _
                                                        And Me.Range(splitArray(17)).Value + splitArray(41) >= 0
End Function

Public Sub UpdateValuesForSet1Using20Through23(ByRef splitArray() As String)
    Dim counter As Long
    For counter = 0 To 3
        Me.Range(splitArray(counter + 14)).Value = Me.Range(splitArray(counter + 14)).Value + splitArray(counter + 20)
    Next
End Sub

Public Sub UpdateValuesForSet1Using38Through41(ByRef splitArray() As String)
    Dim counter As Long
    For counter = 0 To 3
        Me.Range(splitArray(counter + 14)).Value = Me.Range(splitArray(counter + 14)).Value + splitArray(counter + 38)
    Next
End Sub
```
| improve this answer | |
\$\endgroup\$

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.