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.
- Changes the values in two other "sets" of cells:
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.
ARR()
does? It seems like some parts ofARR()
contain cell references while other parts contain values. What is the logic behind the pattern? Why are elements14-17,134-137
address and20-27
values? \$\endgroup\$