I have two public arrays that I am using on one worksheet. When I run the code for one of the tests it shows 13 variables were read in. When run the test again and only one variable should have been added I still see 13 variables. This is why I am trying to clear the array each time I start. All the code using the arrays are on within the same module. When I try to run the code with the ReDim command I get a Compile error: Array already dimensioned.
The problem is all at the top of the code:
The problem is all at the top of the code:
Rich (BB code):
'worksheet_beforedoubleclick 'Associates the master options on the Front Page worksheet with options that may be on the Custom Options worksheet
'UpdateCustomOptions 'Populate the check boxes on the Custom Options worksheet associated with the master check boxes on the Front Page worksheet
Dim COA(30, 2) 'CUSTOM OPTIONS ARRAY
Dim SOA(15) 'SERVICE OPTION ARRAY
Private Sub worksheet_beforedoubleclick(ByVal Target As Range, Cancel As Boolean)
'Created by David Follmann September 2, 2013
'ASSOCIATES THE MASTER OPTIONS ON THE FRONT PAGE WORKSHEET WITH OPTIONS THAT MAY BE ON THE CUSTOM OPTIONS WORKSHEET
Dim Check As String 'Check Mark
'Set Target = ActiveCell '
'ActiveCell.Select '
ReDim COA(30, 2)
ReDim SOA(15)
If Not Intersect(Target, Range("F3:U16")) _
Is Nothing Then 'Was one of the System Options selected?
Cancel = True 'YES: Cancel the edit of the cell.
If ActiveCell.Column / 2 <> _
Int(ActiveCell.Column / 2) Or _
ActiveCell.Interior.TintAndShade <> 0 Then End ' EXIT if the current column number is NOT an even number!
If ActiveCell = "" Then ' Is the Active Cell blank?
Check = "ü" ' YES: Put a check mark in Check variable.
ActiveCell = Check ' Put a check mark in the selected box.
Else ' NO: THE ACTIVE CELL IS NOT BLANK
Check = "" ' Remove the check mark from the Check variable.
ActiveCell = Check ' Uncheck the Active Cell.
End If ' END
'SET MAIN OPTIONS
If ActiveCell.Column = 6 Then ' Is the cell selected in Column 6? (MAIN OPTION)
Call UpdateCOA(Check) ' YES: Get the names and positions of the sub options.
Call UpdateCustomOptions(Check) ' Update the Sub Options by checking the ones that match the Custom Options
Else ' NO: THE SELECTED OPTION IS NOT IN COLUMN 6 (SUB-OPTION)
If ActiveCell.Column / 2 = _
Int(ActiveCell.Column / 2) Then ' Is the current column an even column number?
If ActiveCell.Offset(0, 1) <> "" Then ' YES: Is the cell selected have an option to the right?
AppCheck = ActiveCell.Offset(0, 1) ' YES: Get the name of the option.
Select Case AppCheck ' Choose the option.
Case "L1" ' IS THE OPTION: L1?
SOA(0) = "ATR": SOA(1) = "UEM" ' Add these values to the array
SOA(2) = "UCS": SOA(3) = "UNC" ' Add these values to the array
SOA(4) = "ZDS": SOA(5) = "ZSS" ' Add these values to the array
SOA(6) = "ZC01" ' Add this values to the array
SOA(7) = "Zone X GAS01" ' Add this values to the array
Call FindAndCheckOption(Check) ' Find each of these options and check them if they are on the Custom Options worksheet
Case "L2" ' IS THE OPTION: L2?
SOA(0) = "ATR": SOA(1) = "UEM" ' Add these values to the array
SOA(2) = "UCS": SOA(3) = "UNC" ' Add these values to the array
SOA(4) = "ZDS": SOA(5) = "ZSS" ' Add these values to the array
SOA(6) = "ZC01" ' Add this values to the array
SOA(7) = "Zone X GAS01" ' Add this values to the array
Call FindAndCheckOption(Check) ' Find each of these options and check them if they are on the Custom Options worksheet
Case "M1" ' IS THE OPTION: M1?
SOA(0) = "ATR": SOA(1) = "UEM" ' Add these values to the array
SOA(2) = "UCS": SOA(3) = "UNC" ' Add these values to the array
SOA(4) = "ZDS": SOA(5) = "ZSS" ' Add these values to the array
SOA(6) = "ZC01" ' Add this values to the array
SOA(7) = "Zone X GAS01" ' Add this values to the array
Call FindAndCheckOption(Check) ' Find each of these options and check them if they are on the Custom Options worksheet
Case "M2" ' IS THE OPTION: M2?
SOA(0) = "ATR": SOA(1) = "UEM" ' Add these values to the array
SOA(2) = "UCS": SOA(3) = "UNC" ' Add these values to the array
SOA(4) = "ZDS": SOA(5) = "ZSS" ' Add these values to the array
SOA(6) = "ZC01": SOA(7) = "ZC02" ' Add these values to the array
SOA(8) = "Zone X GAS01" ' Add this values to the array
SOA(9) = "Zone X GAS03" ' Add this values to the array
Call FindAndCheckOption(Check) ' Find each of these options and check them if they are on the Custom Options worksheet
Case "M3" ' IS THE OPTION: M3?
SOA(0) = "ATR": SOA(1) = "SSS" ' Add these values to the array
SOA(2) = "UCS": SOA(3) = "UNC" ' Add these values to the array
SOA(4) = "ZC01": SOA(5) = "ZC02" ' Add these values to the array
SOA(6) = "ZDS": SOA(7) = "ZSS" ' Add these values to the array
SOA(8) = "Zone X GAS01" ' Add this values to the array
SOA(9) = "Zone X GAS02" ' Add this values to the array
SOA(10) = "Zone X GAS03" ' Add this values to the array
SOA(11) = "Sys GAS01" ' Add this values to the array
SOA(12) = "Sys GAS02" ' Add this values to the array
Call FindAndCheckOption(Check) ' Find each of these options and check them if they are on the Custom Options worksheet
Case Else ' THIS OPTION DOES NOT HAVE DEPENDENT TASKS
SOA(0) = ActiveCell.Offset(0, 1) ' Add this value to the array
Call FindAndCheckOption(Check) ' Find this options and check it if it is on the Custom Options worksheet
End Select ' END
End If ' END
End If ' END
End If ' END
End If 'END
Target.Select 'Return to the originaly selected cell.
End Sub
Sub FindAndCheckOption(Check As String)
'Created by David Follmann September 2, 2013
'POPULATE THE CHECK BOXES ON THE CUSTOM OPTIONS WORKSHEET ASSOCIATED WITH THE MASTER CHECK BOXES ON THE FRONT PAGE WORKSHEET
Const FstDataRow As Integer = 4, ColOff As Integer = 4 'First Data Row and Column Offsets
Dim CRow As Integer, CCol As Integer 'Current Row and Column
Const CO As String = "Custom Options" 'Custom Options worksheet
Dim COs As Worksheet 'Create object for Custom Options worksheet
Dim StrFound As Boolean '
CRow = FstDataRow '
CCol = 2 '
Set COs = Sheets(CO) 'Point the object to the Custom Options worksheet
'CurTask = SOA(0) 'FOR TESTING ONLY
ArrCt = ArrayVariableCount("SOA") - 1 '
If ArrCt > 0 Then '
For x = 0 To ArrCt 'Have we gone through all the options?
CurTask = SOA(x) 'FOR TESTING ONLY
StrFound = False '
Do While COs.Cells(CRow, CCol + 1) <> "" 'NO: Is there an option description to the right of this box?
Do While COs.Cells(CRow, CCol + 1) <> "" ' NO: Is there an option description to the right of this box?
If COs.Cells(CRow, CCol + 1) = SOA(x) Then ' YES: Again, is there an option description to the right of this box in this column?
COs.Cells(CRow, CCol) = Check ' YES: Clear the check from the Active box
Call FindText(SOA(x), True) '
If ActiveCell = SOA(x) Then '
ActiveCell.Offset(0, -1) = Check ' Check the box for the current option on the Front Page
StrFound = True '
End If ' END
End If ' END
CRow = CRow + 1 ' Advance the Current Row to the next row.
Loop ' CHECK AGAIN
CRow = FstDataRow ' Move the Current Row back to the First Data Row
CCol = CCol + ColOff ' Advance the Column by the Column Offset
Loop ' CHECK AGAIN
If Not StrFound Then '
If SOA(x) = ActiveCell Then '
ActiveCell.Offset(0, -1) = "" '
Else '
If SOA(x) = ActiveCell.Offset(0, 1) Then '
ActiveCell = "" '
End If '
End If '
End If '
CRow = FstDataRow ' Move the Current Row back to the First Data Row
CCol = 2 ' Move the Current Column back to the First Data Column
Next x 'CHECK AGAIN
End If '
End Sub
Sub UpdateCustomOptions(Check As String)
'Created by David Follmann September 2, 2013
'POPULATE THE CHECK BOXES ON THE CUSTOM OPTIONS WORKSHEET ASSOCIATED WITH THE MASTER CHECK BOXES ON THE FRONT PAGE WORKSHEET
Const FstDataRow As Integer = 4, ColOff As Integer = 4 'First Data Row and Column Offsets
Dim CRow As Integer, CCol As Integer 'Current Row and Column
Const CO As String = "Custom Options" 'Custom Options worksheet
Dim COs As Worksheet 'Create object for Custom Options worksheet
CRow = FstDataRow 'Set the Current Row to the First Row of Data
CCol = 2 'Set the Current Column to the first column of data on the Custom Options worksheet
Set COs = Sheets(CO) 'Point the object to the Custom Options worksheet object
'CurTask = COA(0, 0) 'FOR TESTING ONLY
'ArrCt = ArrayVariableCount(COA) 'FOR TESTING ONLY
For x = 0 To ArrayVariableCount(COA) 'Have we gone through all the options?
'CurTsk = COA(x, 0) 'FOR TESTING ONLY
Set COCell = FindCustomOption(COs, COA(x, 0)) 'YES: Get the cell on the Custom Option worksheet that matches the task.
If COCell = COA(x, 0) Then ' Does the option on the Custom Options worksheet match the current option in the array?
If "L1" = COA(x, 0) Or "L2" = COA(x, 0) Or _
"M1" = COA(x, 0) Or "M2" = COA(x, 0) Or _
"M3" = COA(x, 0) Then ' YES: Is it one of the options with dependents?
If FindText(COA(x, 0), True) Then ' YES: Is the option on the Front Page worksheet?
If Check <> "" Then ' YES: Was the orginal cell checked and not unchecked?
UpdateNMZCSystems = True ' YES: Set the check to update the NM ZC substem MAIN OPTION
End If ' END
ActiveCell.Offset(0, -1).Select ' Select the box for the current option on the Front Page
If Check = "" Then ' Was the original cell unchecked and not checked?
ActiveCell = "ü" ' YES: Check it as it will be reversed in the worksheet_beforedoubleclick routine
Else ' NO: THE ORIGINAL CELL WAS CHECKED.
ActiveCell = "" ' Uncheck it as it will be reversed in the worksheet_beforedoubleclick routine
End If ' END
Call worksheet_beforedoubleclick _
(ActiveCell, True) ' UPDATE THE CURRENT OPTION
End If ' END
Else ' NO: THIS OPTION DOES NOT HAVE ANY DEPENDENCIES
If FindText(COA(x, 0), True) Then ' Is the option on the Front Page worksheet?
ActiveCell.Offset(0, -1) = Check ' YES: Is the box Checked?
End If ' END
COCell.Offset(0, -1) = Check ' Check the box for the current option on the Custom Options
End If ' END
Else ' NO: THE OPTION ON THE CUSTOM OPTIONS WORKSHEET DOES NOT MATCH THE CURRENT OPTION IN THE ARRAY.
If FindText(COA(x, 0), True) And _
ActiveCell.Column > 7 Then ' Is the option on the Front Page worksheet and not a MAIN OPTION?
ActiveCell.Offset(0, -1) = "" ' YES: Uncheck the option as it is NOT in the ITL
End If ' END
End If ' END
Next x 'CHECK AGAIN
If UpdateNMZCSystems Then 'Was one of the NM ZC substem checked?
If FindText("NM ZC subsystem", True) Then 'YES: Is this MAIN OPTION on the Front Page worksheet?
ActiveCell.Offset(0, -1) = "ü" ' YES: Check this MAIN OPTION
End If ' END
End If 'END
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Created by David Follmann September 3, 2013
'DETERMINES WHICH DEVICE WAS UPDATED THEN REQUESTS THE TIME BE ADJUSTED ON THE CUSTOMIZED ITL WORKSHEET
On Error GoTo ErrorHandler: 'If there is an error then exit.
If Intersect(Target, Range("C10,C12,C14")) _
Is Nothing Then Exit Sub 'If one of the three device counts changed then exit
Select Case Target.Offset(0, -1).Value 'Get the name of the device whos count was altered.
Case "Number of Sites" ' Was the Sites count changed
Call UpdateCustomITLWithDevice("Site") ' YES: Find every task with Site in the name and update the time for the task and every task after it for the day.
Case "Number of Routers" ' Was the Router count changed
Call UpdateCustomITLWithDevice("Routers") ' YES: Find every task with Routers in the name and update the time for the task and every task after it for the day.
Case "Number of Switches" ' Was the Switches count changed
Call UpdateCustomITLWithDevice("Switches") ' YES: Find every task with Switches in the name and update the time for the task and every task after it for the day.
End Select 'END
Target.Select '
ErrorHandler: '
End Sub
Private Function UpdateCOA(CheckedOff)
Dim FPRow As Integer, FPCol As Integer 'Front Page Row and Column
Dim TRow As Integer, TCol As Integer 'Temp place holders for the current Row and Column
FPRow = ActiveCell.Row 'Get the current row that is selected on the Front Page
FPCol = ActiveCell.Column 'Get the current column that is selected on the Front Page
TCol = FPCol + 1 'Start with the forth column to the right of the selected column.
TRow = FPRow 'Start on the select row.
x = 0 'Start on the first array position.
'CurTask = COA(0, 0) 'FOR TESTING ONLY
'ArrCt = ArrayVariableCount(COA) 'FOR TESTING ONLY
Do While Cells(TRow, TCol) <> "" 'Is there an option name in the current cell?
COA(x, 0) = Cells(TRow, TCol) 'YES: Get the Name of the current option
COA(x, 1) = TRow ' Get the Row of the current option
COA(x, 2) = TCol - 1 ' Get the Column of the current option
If CheckedOff = "" Then ' Was the original cell checked off?
Cells(TRow, TCol - 1) = "" ' YES: Uncheck the current option
End If ' END
If TCol = FPCol + 1 Then '
TCol = TCol + 2 ' YES: Move the current column two columns to the right.
Else ' NO:
If TRow = FPRow Then ' Is the current row the same as the one selected?
TRow = TRow + 1 ' YES: Move down one row.
Else ' NO: THE CURRENT ROW IS NOT THE SAME AS THE ONE SELECTED
TRow = FPRow ' Make the current row the same as the one selected.
TCol = TCol + 2 ' Move the current column two columns to the right.
End If ' END
End If ' END
x = x + 1 ' Advance to the next array position
Loop 'CHECK AGAIN
End Function
Private Function ArrayVariableCount(Arr As String)
Dim nonEmptyElements As Integer, i As Integer '
nonEmptyElements = 0: i = 0 '
If Arr = "SOA" Then '
For i = LBound(SOA) To UBound(SOA) '
If Not SOA(i) = "" Then '
nonEmptyElements = nonEmptyElements + 1 '
End If '
Next '
Else '
If Arr = "COA" Then '
For i = LBound(COA) To UBound(COA) '
If Not COA(i, 0) = "" Then '
nonEmptyElements = nonEmptyElements + 1 '
End If '
Next '
End If '
End If
ArrayVariableCount = nonEmptyElements '
End Function
