Here is commented and modified code from yesterday. Put this code in a standard module name modMain. Interested in any input to streamline conflict validation, thoughts on thoroughness of the validation and answers to questions about the RegExp pattern. Thanks
Code:
Option Explicit
'A Public variable defined in the WorkBook Selection_Change event used to evaluate conflict with two similar tasks.
Public p_TargetVal As String
Sub Define_Highlight_Task(ByVal oRng As Range)
'Concept process developed and coded by Batman1
'Modified and commented by Greg Maxey to 1) provide error checking\validation of task definitions and 2) ask questions by Greg Maxey
Dim oRegEx As Object, varColors As Variant
Dim lngLength As Long, lngColor As Long, lngCol As Long, lngIndex As Long
Dim strText As String, strSep As String
Dim lngProcessRouter As Long
lngProcessRouter = -9999 'Variable used to route processing based on conditions.
'Define the task\events colors and add to variant array
varColors = Array("15985347", "5296274", "12439801", "65535", "6908415", "0")
'Determine the system decimal separator
strSep = Mid(3 / 2, 2, 1) 'Or we could use strSep = Application.International(xlDecimalSeparator)
'Evaluate the string entered in the active cell range (oRng)
Set oRegEx = CreateObject("VBScript.RegExp")
oRegEx.IgnoreCase = True 'Will match US and us etc. Change to False if we want only US, BR, etc.
strText = oRng.Value
If UCase(strText) <> "L" Then
'Define required code pattern. Batman1 original
oRegEx.Pattern = "^((?:\d*\.)?\d+)(?:|\-)(US|UK|AP|BR|L).*$"
'**********************************************REGEX PATTERN QUESTIONS**********************************************************
'1. Could we use the system separator in the pattern ?? 'oRegEx.Pattern = "^((?:\d*\" & strSep & ")?\d+)(?:|\-)(US|UK|AP|BR|L).*$" _
'2. In original, the "((?:\d*\.)?\d+)"
'I understand that second "?" means the preceeing parenthetical elment (?:\d*\.) does not have to be found. _
That the \d* represents 0 or more numbers, and the \. is a literal period (or in our case decimal separator). _
But what is the purpose of "?:"
'As best I can tell from testing. The pattern can be rewritten either:
'oRegEx.Pattern = "^((\d*\.)?\d+)(?:|\-)(US|UK|AP|BR|L).*$"
'Where those two charcters just aren't used ...
'or ... use a an OR |
'oRegEx.Pattern = "^(\d*\.\d+|\d+)(?:|\-)(US|UK|AP|BR|L).*$"
'3. Similiarliy, the "(?:|\-)".
'I have deduced that signifies the "-" separating the number and region is not required.
'But, what does the "?:" and "\" signify?
'As best I can tell from testing. The pattern can be rewritten:
'oRegEx.Pattern = "^((\d*\.)?\d+)(-*)(US|UK|AP|BR|L).*$"
'**********************************************END QUESTIONS**********************************************************
'Test the target cell text (the task\event code entered) for match.
If oRegEx.test(strText) Then
'Based on the pattern and our code definition, we expect 1 match returned (Item 0), with 2 submatches.
With oRegEx.Execute(strText).Item(0)
'Using the match, use SubMatch(0) to determine task duration (numerical part of match)and Submatch(1) (alpha part of match) to determine color to apply.
strText = .SubMatches(0)
'Validate that the duration defined is a multiple of 0.25. Note - If strSep (see questions above) is used in the pattern, then the Replace method won't be needed.
If ((Replace(strText, ".", strSep)) * 100) Mod 25 = 0 Then
lngLength = Replace(strText, ".", strSep) / 0.25
'Determine color. SubMatch(1), will return either US, UK, AP, BR or L
'InStr(1, USUKAPBR, SubMatch(1)) will return either 1, 3, 5, 7 or 9
'(1-1) / 2 = 0, (3-1) / 2 = 1 and so on.
lngColor = varColors((InStr(1, "USUKAPBRL", .SubMatches(1), vbTextCompare) - 1) / 2)
'We have a valid code
lngProcessRouter = 0
Else
'The duration is not defined as quarter hour increments.
lngProcessRouter = 1
End If
End With
End If
Else
'Just "L" defines the event leave for the rest of the shift.
lngLength = 33 - oRng.Column + 1
lngColor = varColors(4)
'We have a valid definition.
lngProcessRouter = 0
End If
If lngProcessRouter = 0 Then
'Check for conflicts with an existing dissimilar or similar task\events at the target cell.
Select Case True
Case oRng.Interior.color <> 16777215 And oRng.Interior.color <> lngColor
'We are in conflict with an existing dissimilar task e.g., We are trying to define and new break event that conflicts with an existing UK task.
lngProcessRouter = 2
Case oRng.Interior.color <> 16777215 And oRng.Interior.color = lngColor
'We are in an existing similar task. Are we a) at the start of that task and attempting to redefine it or b) in conflict.
'We captured the Target Cell value when we entered the cell. If that cell value is a null string then _
b) we are in conflict with an existing task.
If p_TargetVal = vbNullString Then lngProcessRouter = 2
End Select
If lngProcessRouter = 0 Then 'No conflicts.
lngCol = oRng.Column
'Clear the active cell color
oRng.Interior.color = 16777215
lngIndex = 1
Do While ActiveSheet.Cells(oRng.Row, lngCol + lngIndex).Interior.color <> 16777215 And ActiveSheet.Cells(oRng.Row, lngCol + lngIndex).Value = ""
'Clear subsequent cells until the next subsequent cell is a) already cleared or b) contains text (This would indicate the start of a different task\event).
ActiveSheet.Cells(oRng.Row, lngCol + lngIndex).Interior.color = 16777215
lngIndex = lngIndex + 1
Loop
'Is there time left in the shift for the task defined?
If lngCol + lngLength <= 34 Then
'Yes.
'Ensure the defined task fits the timeline.
For lngIndex = 1 To (lngLength - 1)
If Not ActiveSheet.Cells(oRng.Row, lngCol + lngIndex).Interior.color = 16777215 Then
'An existing task\event start on the time line before this task is finished.
lngProcessRouter = 2 'Invalid task definition. Conflicts with existing task\event.
Exit For
End If
Next
Else
'No, invalid task definition. Exceeds shift time window.
lngProcessRouter = 3
End If
End If
End If
Select Case lngProcessRouter
Case Is = 0
'Record and color code task on worksheet
oRng.Resize(1, lngLength).Interior.color = lngColor
Case Is = 1
MsgBox "The task\event duration is not properly defined." & vbCr + vbCr _
& "A Task\event duration must be defined in quarter hour increments.", vbInformation + vbOKOnly, "INVALID TASK\EVENT DEFINITION"
oRng.Select
Case Is = 2
MsgBox "The defined task\event conflicts with\overlaps an existing task\event." & vbCr + vbCr _
& "Redefine the task\event and try again.", vbInformation + vbOKOnly, "INVALID TASK\EVENT DEFINITION"
oRng.Select
Case Is = 3
MsgBox "The task\event duration is not properly defined and exceeds the shift window.", _
vbInformation + vbOKOnly, "INVALID TASK\EVENT DEFINITION"
oRng.Select
End Select
lbl_Exit:
Set oRegEx = Nothing
Exit Sub
End Sub
Put this code in the ThisWorkBook module:
Code:
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Fires after we define a task\event code and exist target cell.
modMain.Define_Highlight_Task Target(1)
lbl_Exit:
Exit Sub
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Fires when we move the selection into the target cell to define a task\event code. We need this information _
to determine conflicts with similar task\events.
If Target.Cells.Count = 1 Then p_TargetVal = Target.Value
lbl_Exit:
Exit Sub
End Sub