Figure Out Error

Hello,


I would like to solve this error in the given code which is I can't able to figure out what and where it has an error.

The issue is that whenever user enter the Duplicate entry it indicated to its relevant line of code but when it is corrected then it keep on saying that it is Invalid until user press Ok button it removes the entry and then user can enter the right data.

Please help me to solve this out.

Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case True
' Next line Not Nothing then is something so Target is within the range
' this code refers to Column C
Case Not Intersect(Target, Me.Range("C11:C510")) Is Nothing
Call ChangeColC(Target)
End Select
End Sub

Sub ChangeColC(rngTarg As Range)
'Application.ScreenUpdating = False
On Error GoTo ReEnableEvents
Application.EnableEvents = False
'Application.DisplayAlerts = False

Dim regExp As Object
Dim strTarg As String
Dim cEdit As Integer
Dim i As Long
Dim strPattern As String
Dim arrTarg(1 To 4) As String
Dim lngMidChrs As Long
Dim ShtName As String
Dim WrkbookName As String

ShtName = ActiveSheet.Name
WrkbookName = ActiveWorkbook.Name

Set rngCheck = Range("D11:D510")
Set rngBlock = Range("C11:C510")

' New Code for Empty Previous Cell of same Row (Seat No) starts here
If Not Intersect(rngTarg, Me.Range("C11:C510")) Is Nothing Then
If rngTarg.Value = "" Then GoTo ReEnableEvents
If (IsEmpty(rngTarg.Offset(0, -1))) Then
rngTarg.Select
MsgBox "First enter Seat No. in <" & ShtName & ">", vbInformation + vbOKOnly, "Entry Required"
rngTarg.ClearContents
GoTo ReEnableEvents
End If
End If
' New Code for Empty Previous Cell of same Row (Seat No)ends here

'Test if user entered "Applied For" in lieu of Enrol No. code.
'Test in upper case and if correct characters then convert to Proper case"
If UCase(Trim(rngTarg.Value)) = "APPLIED FOR" Then
rngTarg.Value = WorksheetFunction.Proper(Trim(rngTarg.Value))
GoTo ReEnableEvents 'Finished processing because "Applied for" entered
End If

Set regExp = CreateObject("VBScript.RegExp")

'Following line represents: '1st element plus Slash after 1st element
'2nd element plus Slash after 2nd element
'3rd element plus Slash after 3rd element
'4th element

'Convert alpha characters to upper case and remove spaces and slashes (if any)
strTarg = UCase(Replace((Replace(rngTarg.Value, " ", "")), "/", ""))
strPattern = "^[A-Z]{6,7}[0-9]{8}$" 'Pattern to match

If IsAMatch(regExp, strPattern, strTarg) Then
'Insert the slashes in that pattern with 3 alphas in the second block
If Len(strTarg) = 14 Then 'If 3 alpha + 3 alpha + 4 numeric + 4 numeric
rngTarg.Value = Left(strTarg, 3) & "/" & Mid(strTarg, 4, 3) & "/" & Chr(10) _
& Mid(strTarg, 7, 4) & "/" & Mid(strTarg, 11, 4)
Else 'If 3 alpha + 4 alpha + 4 numeric + 4 numeric
'insert the slashes in the pattern with 4 alphas in the second block
rngTarg.Value = Left(strTarg, 3) & "/" & Mid(strTarg, 4, 4) & "/" & Chr(10) _
& Mid(strTarg, 8, 4) & "/" & Mid(strTarg, 12, 4)
GoTo ReEnableEvents
End If

'It will help to remove data if user enter enrolment no as student columns contains "Repeater(s)" Or "Improvement"
If Intersect(rngTarg, rngBlock) Is Nothing Then
GoTo ReEnableEvents ' Do nothing or what you want
Else
If rngTarg.Offset(0, 1) = "Repeater(s)" Or rngTarg.Offset(0, 1) = "Improvement" Then
rngTarg.Select
MsgBox "As you enter <" & rngTarg.Offset(0, 1) & "> in Student's Name Column in <" & ShtName & ">" _
& vbNewLine & "that is why you cannot enter Enrolment No.", vbInformation, "Information"
rngTarg.ClearContents
End If
End If
Application.EnableEvents = True
'ErrHandler:
Else

rngTarg.Select
cEdit = MsgBox("You entered <" & rngTarg & "> is Invalid in <" & ShtName & ">" _
& vbNewLine & "Re-enter the Enrolment No. in one of the following description" _
& vbNewLine & "1. Write only -> applied for <- OR" _
& vbNewLine & "2. First write any 6 Alpha Characters and" _
& vbNewLine & " Second write any 8 Numeric Charaters OR" _
& vbNewLine & "3. First write any 7 Alpha Characters and" _
& vbNewLine & " Second write any 8 Numeric Charaters" _
& vbNewLine & " as provided by Enrolment Section." _
& vbNewLine & "4. Slashes may be omitted during entry." _
& vbNewLine & "Click Ok for Remove Enrolment no OR" _
& vbNewLine & "Click Cancel for Correction", vbCritical + vbOKCancel + vbDefaultButton2, "Invalid Entry!")
If cEdit = vbOK Then
rngTarg.ClearContents
End If
If cEdit = vbCancel Then
rngTarg.Select
Application.SendKeys "{F2}"
End If

ReEnableEvents:

' New Code for Duplication Entry starts here
If WorksheetFunction.CountIf(Me.Range("C11:C510"), rngTarg.Value) > 1 And rngTarg.Value <> "Applied For" Then
rngTarg.Select
cEdit = MsgBox("You have enter the Enrolment No. <" & rngTarg.Value & "> in <" & ShtName & ">" _
& vbNewLine & "is already exist. Click Ok to remove OR" _
& vbNewLine & "Click Cancel for Correction", vbExclamation + vbOKCancel + vbDefaultButton2, "Duplicate Entry!")
If cEdit = vbOK Then
rngTarg.ClearContents
End If
If cEdit = vbCancel Then
rngTarg.Select
Application.SendKeys "{F2}"
End If
Application.EnableEvents = True

End If
' New Code for Duplication Entry ends here

If Err.Number <> 0 Then
MsgBox "Error occurred in Private Sub Worksheet_Change." _
& vbNewLine & "Refer to Administrator Muneeb (KUBS - University of Karachi)" _
& vbNewLine & "of this workbook.", vbCritical, "Error!"
End If
Application.EnableEvents = True
'Application.ScreenUpdating = True
End If
Application.EnableEvents = True
End Sub