none
Figure out Error RRS feed

  • Question

  • Hi

    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




    • Edited by SMuneebH Saturday, December 5, 2015 10:56 AM
    Saturday, December 5, 2015 5:46 AM

Answers

  • 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.

    You have to debug your code by yourself, then you can easily find the issue.

    Place a breakpoint on the first line in your sub, switch to the sheet, make an input. The code is called and stops at the breakpoint, now debug it line by line by pressing the F8-key.

    If you don't know how to debug a code, have a look into this tutorial:
    http://www.wiseowl.co.uk/blog/s161/online-excel-vba-training.htm

    Andreas.

    • Marked as answer by SMuneebH Sunday, December 6, 2015 6:11 PM
    Sunday, December 6, 2015 6:09 AM