locked
Macro is getting an error type mismatch for importing a data RRS feed

  • Question

  • Hello,

    Our account specialist is using macro for importing and exporting files for years. She is getting an type mismatch error after windows 10 and office 2016 upgrade according to her. I tried to change datatype but still getting a same error message. Do you have any idea to solve this kind of issue? I am also attaching my xlsm file and also xls file.

    I attached vba code here.

    ' v.2 10/29/2002 ' used M for filespec
    '                   Locked cells
    '                   isnumeric validity check for phone number
    ' v.3 11/1/2002     three period type
    '                   import function added
    ' v.4 11/19/2002    Output 00's instead of blanks for dates
    '                    Output 000 for undetermined status
    '                   Add one to record count in header record
    ' v.5 11/21/2002    Output spaces instead of zeros for dates
    ' v1.0 12/4/2002    Added ad to picklist page, fixed spelling in A12
    ' v1.1 12/12/2002   Remove address requirement
    ' v1.2 12/27/2002   Problem with pull-down in A49
    ' v1.3 1/8/2003     Import fields in wrong order
    ' v1.4 2/13/03      replace future active '000' with '   '
    ' 10/15/2012 rch - added code to allow export file location, changed font to white to hide job category and job classification data
    
    
    
    
    
    Function Validate() As Boolean
    On Error GoTo Validate_Error
    
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim rgJobCategories As Range
    Dim rgJobClassification As Range
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
        Validate = True
        ' check the employer code is numeric
        If Not IsNumeric(rgEmployerData.Cells(1, 3).Value) Then
            MsgBox "Invalid Employer code.", vbCritical, "Entry error"
            Validate = False
        End If
        ' check the file start code is 3 characters
        If Len(Trim(rgEmployerData.Cells(2, 3).Value)) <> 3 Then
            MsgBox "Invalid File Start Code.", vbCritical, "Entry Error"
            Validate = False
        End If
        ' check monthly/bi-weekly code is a M, B1 or B2
        If Not IsNumeric(rgEmployerData.Cells(5, 3).Value) Or rgEmployerData.Cells(5, 3).Value < 1 Or rgEmployerData.Cells(5, 3).Value > 3 Then
            MsgBox "Invalid Payroll cycle", vbCritical, "Entry error"
            Validate = False
        End If
    
        ' check File Creation is a date
        If Not IsDate(rgEmployerData.Cells(6, 3).Value) Then
            MsgBox "Invalid Period Ending Date", vbCritical, "Entry Error"
            Validate = False
        End If
            
    For I = 1 To 500
        ' if this record as a SSN or last name check it.  Otherwise skip it.
        
        If Trim(rgEmployeeData.Cells(I, 3).Value) <> "" Or Trim(rgEmployeeData.Cells(I, 6).Value) <> "" Then
        
        ' check for valid SSN
            If Len(rgEmployeeData.Cells(I, 3).Value) <> 9 Then
                MsgBox "Invalid Social Security Number for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            If Not IsNumeric(rgEmployeeData.Cells(I, 3).Value) Then
                MsgBox "Invalid Social Security Number for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
        
        ' check for valid first
            If Len(rgEmployeeData.Cells(I, 4).Value) < 1 Then
                MsgBox "Invalid first name for " & rgEmployeeData.Cells(I, 3).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
        
        ' check for valid last
            If Len(rgEmployeeData.Cells(I, 6).Value) < 1 Then
                MsgBox "Invalid last name for " & rgEmployeeData.Cells(I, 3).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid sex
            If UCase(Left(rgEmployeeData.Cells(I, 8).Value, 1)) = "M" Or UCase(Left(rgEmployeeData.Cells(I, 8).Value, 1)) = "F" Then
            Else
            MsgBox "Invalid sex for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
                    
        ' check the birth date for validity
            If Not IsDate(rgEmployeeData.Cells(I, 9).Value) And Not rgEmployeeData.Cells(I, 9).Value = "" Then
                MsgBox "Invalid birth date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid address
        '    If Len(rgEmployeeData.Cells(I, 10).Value) < 1 Then
        '        MsgBox "Invalid address for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
        '        Validate = False
        '        Exit Function
        '    End If
            
        ' check for valid city
            If Len(rgEmployeeData.Cells(I, 13).Value) < 1 Then
                MsgBox "Invalid city for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid state
            If Len(rgEmployeeData.Cells(I, 14).Value) <> 2 Then
                MsgBox "Invalid state for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid zip
            If Len(rgEmployeeData.Cells(I, 15).Value) = 5 Or Len(rgEmployeeData.Cells(I, 15).Value) = 9 Then
            Else
            MsgBox "Invalid zip for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid phone
            If Not IsNumeric(rgEmployeeData(I, 17).Value) Then
                MsgBox "Invalid phone for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value & " (Numbers only.)", vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
            If Len(rgEmployeeData.Cells(I, 17).Value) > 10 Then
            MsgBox "Invalid phone for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value & " (Exceeds 10 chars.)", vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
            
            
        ' check the hire date for validity
            If Not IsDate(rgEmployeeData.Cells(I, 19).Value) And Not rgEmployeeData.Cells(I, 19).Value = "" Then
                MsgBox "Invalid Hire date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
    '  check termination date
            If Not IsDate(rgEmployeeData.Cells(I, 20).Value) And Not rgEmployeeData.Cells(I, 20) = "" Then
                MsgBox "Invalid Termination date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
    '  check Future Status date
            If rgEmployeeData.Cells(I, 21).Value <> "" Then
                If Not IsDate(rgEmployeeData.Cells(I, 21).Value) Then
                    MsgBox "Invalid future date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                    Validate = False
                    Exit Function
                End If
            End If
            
        ' check for proper active/term status
            If rgEmployeeData.Cells(I, 21).Value <> "" Then
                If UCase(Left(rgEmployeeData.Cells(I, 22).Value, 1)) = "A" Or UCase(Left(rgEmployeeData.Cells(I, 8).Value, 1)) = "T" Then
                Else
                    MsgBox "Invalid Active/Term for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                    Validate = False
                    Exit Function
                End If
            End If
        ' check for proper FTE %
            If Not IsNumeric(rgEmployeeData.Cells(I, 23).Value) Then
                MsgBox "Invalid FTE % for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            If rgEmployeeData.Cells(I, 23).Value > 1 Or rgEmployeeData.Cells(I, 23).Value < 0 Then
                MsgBox "Invalid FTE % for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            v = RecordCount
        
        End If
    Next I
    
        Exit Function
    
    Validate_Error:
        MsgBox Err.Description, vbCritical, "Validate"
    
    
    End Function
    
    
    Function RecordCount() As Integer
    ' this function will count the number of records ready to be transmitted
    
    On Error GoTo RecordCount_Error
    
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim R As Integer
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    RecordCount = 0
    For R = 1 To 500
        If Trim(rgEmployeeData.Cells(R, 3).Value) <> "" Or Trim(rgEmployeeData.Cells(R, 6).Value) <> "" Then
            RecordCount = RecordCount + 1
        End If
    Next R
    ' compare record count
        If RecordCount <> rgEmployerData.Cells(7, 3).Value Then
            MsgBox "Updating Record count to: " & RecordCount, vbInformation, "Updating record count"
            rgEmployerData.Cells(7, 3) = RecordCount
        End If
            
    
    
    Exit Function
    
    
    RecordCount_Error:
    MsgBox Err.Description, vbCritical, "RecordCount"
    
    End Function
    Sub cmdExport()
    On Error GoTo cmdExport_Error
    '
    '
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim rgJobCategories As Range
    Dim rgJobClassification As Range
    
    Dim R As Long, C As Long
    Dim FileSpec As String
    Dim PLine As String
    
    If Not Validate Then
        Exit Sub
    End If
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
    On Error GoTo File_Error
    
    If Right(rgEmployerData.Cells(9, 3).Value, 1) <> "\" Then
        rgEmployerData.Cells(9, 3).Value = rgEmployerData.Cells(9, 3).Value & "\"
    End If
    FileSpec = rgEmployerData.Cells(9, 3).Value & rgEmployerData.Cells(2, 3).Value & Format(rgEmployerData.Cells(6, 3).Value, "MM") & Right(Format(rgEmployerData.Cells(6, 3).Value, "yyyy"), 4) & "M.txt"
    Open FileSpec For Input As #1
    Close #1
     v = MsgBox("The file " & FileSpec & " already exits.", vbOKCancel)
     If v = vbCancel Then
        Exit Sub
     End If
    NewFile:
    Open FileSpec For Output As #1
    
    
    On Error GoTo cmdExport_Error
    
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
    ' first send the header record
        ' header id
        PLine = Format(Date, "mmdd")
        ' employer code
        PLine = PLine & Format(rgEmployerData.Cells(1, 3).Value, "0000000")
        ' record cound
        ' add 1 to the record count for the header record
        PLine = PLine & Format(rgEmployerData.Cells(7, 3).Value, "00000")
        ' File creation date period
        PLine = PLine & Format(rgEmployerData.Cells(6, 3).Value, "mmddyyyy")
        
        Print #1, PLine
    
    For R = 1 To 500
        ' if this record has a SSN or last name check it.  Otherwise skip it.
        
        If Trim(rgEmployeeData.Cells(R, 3).Value) <> "" Or Trim(rgEmployeeData.Cells(R, 6).Value) <> "" Then
        
        ' header id
            PLine = Format(Format(Date, "mmdd"), "0000")
        ' employer code
        PLine = PLine & Format(rgEmployerData.Cells(1, 3).Value, "0000000")
        ' billing entity code
            PLine = PLine & Format(rgEmployerData.Cells(4, 3).Value, "0000")
        ' agreement code
            PLine = PLine & Format(rgEmployerData.Cells(5, 3), "000000")
       ' site code
            PLine = PLine & "     "
        ' ssn
            PLine = PLine & Format(rgEmployeeData.Cells(R, 3), "000000000")
        ' last name
            PLine = PLine & Left((rgEmployeeData.Cells(R, 6).Value & Space(50)), 50)
        ' first name
            PLine = PLine & Left((rgEmployeeData.Cells(R, 4).Value & Space(50)), 50)
        ' middle
            PLine = PLine & Left((rgEmployeeData.Cells(R, 5).Value & Space(50)), 50)
        ' suffix
            PLine = PLine & Left((rgEmployeeData.Cells(R, 7).Value & Space(3)), 3)
        ' sex
            PLine = PLine & UCase(Left((rgEmployeeData.Cells(R, 8).Value & Space(3)), 1))
        ' birthdate
            PLine = PLine & Format(rgEmployeeData.Cells(R, 9).Value, "mmddyyyy")
        ' address 1
            PLine = PLine & Left((rgEmployeeData.Cells(R, 10).Value & Space(50)), 50)
        ' address 2
            PLine = PLine & Left((rgEmployeeData.Cells(R, 11).Value & Space(50)), 50)
        ' address 3
            PLine = PLine & Left((rgEmployeeData.Cells(R, 12).Value & Space(50)), 50)
        ' city
            PLine = PLine & Left((rgEmployeeData.Cells(R, 13).Value & Space(50)), 50)
        ' state
            PLine = PLine & Left((rgEmployeeData.Cells(R, 14).Value & Space(2)), 2)
        ' zip
            PLine = PLine & Left((rgEmployeeData.Cells(R, 15).Value & Space(9)), 9)
        ' country
            PLine = PLine & Left((rgEmployeeData.Cells(R, 16).Value & Space(3)), 3)
        ' phone
            PLine = PLine & Left((rgEmployeeData.Cells(R, 17).Value & Space(10)), 10)
        ' e-mail
            PLine = PLine & Left((rgEmployeeData.Cells(R, 18).Value & Space(30)), 30)
        ' job category
            Select Case rgEmployeeData.Cells(R, 1)
                Case 1
                    PLine = PLine & Left(rgJobCategories.Cells(1, 1) + Space(2), 2)
                Case 2
                    PLine = PLine & Left(rgJobCategories.Cells(2, 1) + Space(2), 2)
                Case 3
                    PLine = PLine & Left(rgJobCategories.Cells(3, 1) + Space(2), 2)
                Case 4
                    PLine = PLine & Left(rgJobCategories.Cells(4, 1) + Space(2), 2)
                Case 5
                    PLine = PLine & Left(rgJobCategories.Cells(5, 1) + Space(2), 2)
                Case 6
                    PLine = PLine & Left(rgJobCategories.Cells(6, 1) + Space(2), 2)
                Case 7
                    PLine = PLine & Left(rgJobCategories.Cells(7, 1) + Space(2), 2)
                Case 8
                    PLine = PLine & Left(rgJobCategories.Cells(8, 1) + Space(2), 2)
                Case Else
                    MsgBox "You have entered an invalid Job Category on row " & R & ".", vbCritical, "Invalid data"
                    Exit Sub
            End Select
        ' job classification
            Select Case rgEmployeeData.Cells(R, 2)
                Case 1
                    PLine = PLine & Left(rgJobClassifications.Cells(1, 1) + Space(2), 2)
                Case 2
                    PLine = PLine & Left(rgJobClassifications.Cells(2, 1) + Space(2), 2)
                Case 3
                    PLine = PLine & Left(rgJobClassifications.Cells(3, 1) + Space(2), 2)
                Case 4
                    PLine = PLine & Left(rgJobClassifications.Cells(4, 1) + Space(2), 2)
                Case Else
                    MsgBox "You have entered an invalid Job Category on row " & R & ".", vbCritical, "Invalid data"
                    Exit Sub
            End Select
    
        ' hire date
            If rgEmployeeData.Cells(R, 19).Value = "" Then
                PLine = PLine & Space(8)
            Else
                PLine = PLine & Format(rgEmployeeData.Cells(R, 19).Value, "mmddyyyy")
            End If
        ' termination date
            If rgEmployeeData.Cells(R, 20).Value = "" Then
                PLine = PLine & Space(8)
            Else
                PLine = PLine & Format(rgEmployeeData.Cells(R, 20).Value, "mmddyyyy")
            End If
        ' future status date
            If rgEmployeeData.Cells(R, 21).Value = "" Then
                PLine = PLine & Space(8)
            Else
                PLine = PLine & Format(rgEmployeeData.Cells(R, 21).Value, "mmddyyyy")
            End If
        ' future status
            Select Case UCase(Left(rgEmployeeData.Cells(R, 22), 1))
            Case "A"
                PLine = PLine & "ACT"
            Case "T"
                PLine = PLine & "TRM"
            Case Else
                PLine = PLine & "   "
            End Select
            
        
        ' fte percentage
            PLine = PLine & Format(rgEmployeeData.Cells(R, 23).Value * 100, "000")
            Print #1, PLine
        End If
    Next R
    
    Close #1
    MsgBox "Export file: " & FileSpec & " created.", vbInformation, "Success"
    Exit Sub
    
    cmdExport_Error:
            MsgBox Err.Description, vbCritical, "cmdExport"
            Exit Sub
    
    File_Error:
        'MsgBox Err.Number
        If Err.Number = 53 Then ' file not found
            Resume NewFile:
        Else
            MsgBox Err.Number, Err.Description, vbc, "cmdExport"
            Resume Next
        End If
    
    End Sub
    
    Sub Showform()
        Load MemberForm
        MemberForm.Show
    End Sub
    
    Sub Import()
    On Error GoTo Import_Error
    '
    '
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim rgJobCategories As Range
    Dim rgJobClassification As Range
    
    Dim R As Long, C As Long
    Dim FileSpec As String
    Dim PLine As String
    Dim JobCategory, JobClassifiction, SSN, FName, MName, Lname, Suffix, Active, Gross, Member, Total, FTE, HireDate, TerminationDate As String
     Dim Inrec As String
    
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
    ' clear the rows
    For R = 1 To 500
        For C = 1 To 23
            rgEmployeeData.Cells(R, C).Value = ""
        Next C
    Next R
    R = 0
    
    On Error GoTo File_Error
    FileSpec = rgEmployerData.Cells(8, 3).Value
    Open FileSpec For Input As #1
    
    
    On Error GoTo Import_Error
    
    Do While Not EOF(1)
    Line Input #1, Inrec
        R = R + 1
    
        ' job category
                x = UCase(Trim(ParseInrec(Inrec, 1)))
            Select Case UCase(Trim(ParseInrec(Inrec, 17)))
                Case "R"
                    rgEmployeeData.Cells(R, 1) = 1
                Case "RT"
                    rgEmployeeData.Cells(R, 1) = 2
                Case "RP"
                    rgEmployeeData.Cells(R, 1) = 3
                Case "AP"
                    rgEmployeeData.Cells(R, 1) = 4
                Case "RE"
                    rgEmployeeData.Cells(R, 1) = 5
                Case "RW"
                    rgEmployeeData.Cells(R, 1) = 6
                Case "LW"
                    rgEmployeeData.Cells(R, 1) = 7
                Case "PT"
                    rgEmployeeData.Cells(R, 1) = 8
                Case Else
                    MsgBox "Invalid Job Category in input file row " & R, vbCritical, "Import Error"
                    Exit Sub
            End Select
        ' job classification
            Select Case UCase(Trim(ParseInrec(Inrec, 18)))
                Case "AD"
                    rgEmployeeData.Cells(R, 2) = 1
                Case "TE"
                    rgEmployeeData.Cells(R, 2) = 2
                Case "OC"
                    rgEmployeeData.Cells(R, 2) = 3
                Case "NC"
                    rgEmployeeData.Cells(R, 2) = 4
                Case Else
                    MsgBox "Invalid Job Classification in input file row " & R, vbCritical, "Import Error"
                    Exit Sub
            End Select
        ' ssn
            rgEmployeeData.Cells(R, 3).Value = UCase(Trim(ParseInrec(Inrec, 1)))
        ' last name
            If Len(ParseInrec(Inrec, 2)) = 0 Then
                MsgBox "Missing Last Name in input file row " & R, vbCritical, "Import Error"
            Else
                rgEmployeeData.Cells(R, 6).Value = Trim(ParseInrec(Inrec, 2))
            End If
        ' first name
            rgEmployeeData.Cells(R, 4).Value = Trim(ParseInrec(Inrec, 3))
        ' initial
            rgEmployeeData.Cells(R, 5).Value = Trim(ParseInrec(Inrec, 4))
        ' suffix
            rgEmployeeData.Cells(R, 7).Value = Trim(ParseInrec(Inrec, 5))
        ' sEX
        If Left(UCase(Trim(ParseInrec(Inrec, 6))), 1) = "M" Then
            rgEmployeeData.Cells(R, 8).Value = "M"
        End If
        If Left(UCase(Trim(ParseInrec(Inrec, 6))), 1) = "F" Then
            rgEmployeeData.Cells(R, 8).Value = "F"
        End If
        ' Birthday
        If IsDate(ParseInrec(Inrec, 7)) Or Trim(ParseInrec(Inrec, 7)) = "" Then
            rgEmployeeData.Cells(R, 9).Value = Trim(ParseInrec(Inrec, 7))
        Else
            MsgBox "Non-date entry for Birth Date found in input file row " & R, vbCritical, "Import Error"
        End If
        ' Address1
        rgEmployeeData.Cells(R, 10).Value = Trim(ParseInrec(Inrec, 8))
        ' address2
        rgEmployeeData.Cells(R, 11).Value = Trim(ParseInrec(Inrec, 9))
        ' address3
        rgEmployeeData.Cells(R, 12).Value = Trim(ParseInrec(Inrec, 10))
        ' city
        rgEmployeeData.Cells(R, 13).Value = Trim(ParseInrec(Inrec, 11))
        ' state
        rgEmployeeData.Cells(R, 14).Value = UCase(Trim(ParseInrec(Inrec, 12)))
        ' zip
        If IsNumeric(Trim(ParseInrec(Inrec, 13))) Or Trim(ParseInrec(Inrec, 13)) = "" Then
            rgEmployeeData.Cells(R, 15).Value = Trim(ParseInrec(Inrec, 13))
        Else
            MsgBox "Non-numeric entry for Zip Code found in input file row " & R, vbCritical, "Import Error"
        End If
        ' Country
        rgEmployeeData.Cells(R, 16).Value = Trim(ParseInrec(Inrec, 14))
        ' phone
        If IsNumeric(Trim(ParseInrec(Inrec, 15))) Or Trim(ParseInrec(Inrec, 15)) = "" Then
            rgEmployeeData.Cells(R, 17).Value = Trim(ParseInrec(Inrec, 15))
        Else
            MsgBox "Non-numeric entry for Phone found in input file row " & R, vbCritical, "Import Error"
        End If
        ' e-mail
        rgEmployeeData.Cells(R, 18).Value = Trim(ParseInrec(Inrec, 16))
        ' hire date
        If IsDate(ParseInrec(Inrec, 19)) Or Trim(ParseInrec(Inrec, 19)) = "" Then
            rgEmployeeData.Cells(R, 19).Value = Trim(ParseInrec(Inrec, 19))
        Else
            MsgBox "Non-date entry for Hire Date found in input file row " & R, vbCritical, "Import Error"
        End If
        ' term date
        If IsDate(ParseInrec(Inrec, 20)) Or Trim(ParseInrec(Inrec, 20)) = "" Then
            rgEmployeeData.Cells(R, 20).Value = Trim(ParseInrec(Inrec, 20))
        Else
            MsgBox "Non-date entry for Termination Date found in input file row " & R, vbCritical, "Import Error"
        End If
        '  future date
        If IsDate(ParseInrec(Inrec, 21)) Or Trim(ParseInrec(Inrec, 21)) = "" Then
            rgEmployeeData.Cells(R, 21).Value = Trim(ParseInrec(Inrec, 21))
        Else
            MsgBox "Non-date entry for Future Date found in input file row " & R, vbCritical, "Import Error"
        End If
        ' future status
        rgEmployeeData.Cells(R, 22).Value = UCase(Trim(ParseInrec(Inrec, 22)))
        ' FTE
        If IsNumeric(ParseInrec(Inrec, 23)) Then
            rgEmployeeData.Cells(R, 23).Value = ParseInrec(Inrec, 23) / 100
        Else
            MsgBox "Non-numeric entry for FTE found in input file row " & R, vbCritical, "Import Error"
        End If
        
        
        'rgEmployerData.Cells(7, 3).Value = R
        
        Loop
    
    Close #1
    MsgBox "Import completed. " & R & " rows imported.", vbInformation, "Success"
    Exit Sub
    
    Import_Error:
        MsgBox Err.Description & " Record: " & Inrec, vbCritical, "Import"
        Exit Sub
    
    File_Error:
        'MsgBox Err.Number
        If Err.Number = 53 Then ' file not found
            MsgBox "Input file not found.", vbCritical, "Bad filename"
            
        Else
            MsgBox Err.Number, Err.Description, vbc, "Import"
            Resume Next
        End If
    
    
    End Sub
    Function ParseInrec(Inrec, FieldNo)
        On Error GoTo ParseInrec_Error
        Dim Inrec2 As String
        Dim I As Integer
        
        Select Case FieldNo
            Case Is = 1
                Inrec2 = Inrec
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 2
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 3
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 4
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 5
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 6
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 7
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 8
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 9
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 10
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 11
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
    
            Case Is = 12
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 13
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 14
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 15
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 16
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 17
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 18
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 19
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 20
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 21
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 22
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 23
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
       
       
        End Select
        Exit Function
    
    ParseInrec_Error:
    
        MsgBox Err.Description & " R/F: " & R & " " * FieldNo, vbCritical, "ParseInrec"
        
    End Function
    
    


    Virtual Reality

    Monday, August 29, 2016 9:24 PM

All replies

  • I am getting an error in above code.


    Virtual Reality


    • Edited by VR16 Monday, August 29, 2016 10:21 PM
    Monday, August 29, 2016 9:34 PM
  • Hi,

    This is the forum to discuss questions and feedback for Microsoft Excel, I'll move your question to the MSDN forum for Excel

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,

    Emi Zhang


    Please remember to mark the replies as an answers if they help and unmark them if they provide no help.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Tuesday, August 30, 2016 6:34 AM
  • Hi VR16,

    According to your description, MsgBox function syntax is:

    MsgBox(prompt[, buttons] [, title] [, helpfile, context])

    So you could modify your code like below:
    MsgBox Err.Number, vbCritical, Err.Description, "Import"
    For more information, click here to refer about MsgBox Function

    In addition we are not able find your xlsm file and also xls file, so I suggest that you could help us figure out which line code cause your issue, and upload your xlsm file and xls file on OneDrive, that will help us reproduce and resolve it.

    Thanks for your understanding.
    Wednesday, August 31, 2016 7:53 AM

  • Virtual Reality

    Wednesday, August 31, 2016 9:02 PM
  • Hi VR16,

    Based on your screenshot, since this error is not english, I suggest that you could use translator to translate error information into english, and help us figure out which operation or VBA code cause this error is thrown.

    Full information will help us reproduce and resolve your issue.

    Thanks for your understanding.
    Thursday, September 1, 2016 6:22 AM