Hi guys,
I'm just having a little problem with some code. A colleague and I wrote two separate pieces of code and we're now trying to combine it into the one worksheet.
I believe the problem lies with the fact that we have Two "Private Sub Worksheet_Change(ByVal Target As Range)" events in the same worksheet.
When I remove one of the "Private Sub Worksheet_Change(ByVal Target As Range)" - I still can't get things to work.
Does anyone have a solution? If so it would be much appreciated.
Here it is:
Private Sub Worksheet_Change(ByVal Target As Range)
'Hard-coded ranges may be a maintenance issue
On Error GoTo ErrHandler
'Create a dialog which appears when Fail or Retest is selected for a test case and the corresponding JIRA column is blank
If Not Intersect(Target, Range("$M$2:$M$1048576")) Is Nothing Then
Application.EnableEvents = False
If (Target.Value = "Fail" Or Target.Value = "Retest") And IsEmpty(Range("$R$" & Target.Row)) Then
MsgBox "A JIRA must be present for a test of status Fail or Retest"
'Range("$R$" & Target.Row).Font.Color = vbRed
'Range("$R$" & Target.Row).Font.Bold = True
'Range("$R$" & Target.Row).Value = "A JIRA number is required"
End If
Application.EnableEvents = True
End If
'Update the number of test cases without priority
If Not Intersect(Target, Range("$I$2:$I$1048576")) Is Nothing Then
Application.EnableEvents = False
Dim numberWithoutPriority As Integer
'Number test cases without priority = (number of non-blank test case ids) - (number of non-blank priorities)
numberWithoutPriority = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("02. Test Cases").Range("$A$2:$A$1048576")) _
- Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("02. Test Cases").Range("$I$2:$I$1048576"))
ThisWorkbook.Sheets("01. Document Info").Range("$B$10").Value = numberWithoutPriority
Application.EnableEvents = True
End If
'Update the number of test cases without status and number of test cases missing JIRAs
If (Not Intersect(Target, Range("$M$2:$M$1048576")) Is Nothing) Or (Not Intersect(Target, Range("$R$2:$R$1048576")) Is Nothing) Then
Application.EnableEvents = False
Dim numberWithoutStatus As Integer
Dim numberMissingJIRAs As Integer
'Number test cases without status = (number of non-blank test case ids) - (number of non-blank statuses)
numberWithoutStatus = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("02. Test Cases").Range("$A$2:$A$1048576")) _
- Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("02. Test Cases").Range("$M$2:$M$1048576"))
'Number test cases missing JIRA
numberMissingJIRAs = 0
For Each c In ThisWorkbook.Sheets("02. Test Cases").Range("$M$2:$M$1048576").Cells
If IsEmpty(ThisWorkbook.Sheets("02. Test Cases").Range("$A$" & c.Row)) Then
Exit For
ElseIf ((c.Value = "Retest" Or c.Value = "Fail") And IsEmpty(ThisWorkbook.Sheets("02. Test Cases").Range("$R$" & c.Row))) Then
numberMissingJIRAs = numberMissingJIRAs + 1
End If
Next
ThisWorkbook.Sheets("01. Document Info").Range("$B$9").Value = numberWithoutStatus
ThisWorkbook.Sheets("01. Document Info").Range("$B$11").Value = numberMissingJIRAs
Application.EnableEvents = True
End If
ErrHandler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Activate()
Application.CommandBars.FindControl(ID:=847).Enabled = False
End Sub
Private Sub Worksheet_Deactivate()
Application.CommandBars.FindControl(ID:=847).Enabled = True
Me.Name = "02. Test Cases"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Does the validation range still have validation?
If Not Intersect(Range("ValidationRange"), Target) Is Nothing Then
Application.EnableEvents = False
If HasValidation(Intersect(Range("ValidationRange"), Target)) = False Then
Application.Undo
MsgBox "Your last operation was canceled." & vbCrLf & _
"It would have deleted data validation rules.", vbCritical
End If
End If
Application.EnableEvents = True
End Sub
Private Function HasValidation(r As Range) As Boolean
' Returns True if every cell in Range r uses Data Validation
Dim c As Range
Dim x As XlDVType
On Error Resume Next
For Each c In r.Cells
x = r.Validation.Type
If Err Then
HasValidation = False
Exit Function
End If
Next c
HasValidation = True
End Function
Bookmarks