VBA - throwing exceptions for specific errors in working code, IsNumeric issue?

user4888

I apologize if the title is vague. I did not know how else to reference this question.

I have code which forces the length of any TL values to be a length of 6 numbers following "TL-", and does the same with CT values to a length of 4 following "CT-". If it is too short, 0s are added after "TL-"; if it is too long, 0s are deleted from right after "TL-".

TL- 0012    ->  TL-000012
TL-0008981  ->  TL-008981
TL - 008    ->  TL-000008

The code gets the 6 numbers after finding a string "TL", puts "TL-" in the cell and then the six numbers. I have run into a few problems that I have not been succesful in fixing.

MAIN ISSUE: If are more numbers present, it will grab all of those numbers.

One of the other troubleshoot issues that came up was if there is another TL value, it would grab all the numbers and add it. Now, it will see that string "TL" occurs for a second time, and delete it and anything following it. I hope to apply the same type of fix on the other issues.

Example Output:

Start:                        Output:
TL-000487  #3 5/7" Cutter     TL-487357
TL-000037(N123t3-01)          TL-37123301
TL-000094        CTAT15123    TL-9415123
TL-000187 TL-00017 TL-000678  TL-000187
TL-000205 TL-000189           TL-000205
TL-000996:.096 REAMER         TL-996096
TL-002313-(MF-4965)           TL-23134965

Desired Output:

Start:                        Output:
TL-000487  #3 5/7" Cutter     TL-000487
TL-000037(N123t3-01)          TL-000037
TL-000094        CTAT15123    TL-000094
TL-000187 TL-00017 TL-000678  TL-000187
TL-000205 TL-000189           TL-000205
TL-000996:.096 REAMER         TL-000996
TL-002313-(MF-4965)           TL-002313

If anyone could help me troubleshoot these issues, I would find it most informative and helpful.

CODE:

'force length of TL/CT to be 6/4 numbers long, eliminate spaces
Dim str As String, ret As String, tmp As String, j As Integer, k As Integer
For k = 2 To StartSht.Range("C2").End(xlDown).Row
    ret = ""
    str = StartSht.Range("C" & k).Value

    'for TL numbers
    If InStr(str, "TL") > 0 Then
    'if more than one TL value, delete everything after the first TL number
    If InStr(3, str, "TL") > 0 Then str = Mid(str, 1, InStr(3, str, "TL") - 2)
        For j = 1 To Len(str)
            tmp = Mid(str, j, 1)
            If IsNumeric(tmp) Then ret = ret + tmp
        Next j
        'force to 6 numbers if too short; add 0s immediately after "TL-"
        For j = Len(ret) + 1 To 6
            ret = "0" & ret
        Next j
        'force to 6 numbers if too long; eliminate 0s immediately after "TL-"
        If Len(ret) > 6 Then
            Debug.Print Len(ret)
            For j = Len(ret) To 7 Step -1
            If Mid(ret, 1, 1) = "0" Then
                ret = Right(ret, j - 1)
            End If
            Next j
        End If
        'eliminate superfluous spaces around "TL-"
        ret = "TL-" & ret
        StartSht.Range("C" & k).Value = ret


    'for CT numbers
    ElseIf InStr(str, "CT") > 0 Then
        For j = 1 To Len(str)
            tmp = Mid(str, j, 1)
            If IsNumeric(tmp) Then ret = ret + tmp
        Next j
        'force to 4 numbers if too short; add 0s immediately after "CT-"
        For j = Len(ret) + 1 To 4
            ret = "0" & ret
        Next j
        'force to 4 numbers if too long; eliminate 0s immediately after "CT-"
        If Len(ret) > 4 Then
            Debug.Print Len(ret)
            For j = Len(ret) To 5 Step -1
            If Mid(ret, 1, 1) = "0" Then
                ret = Right(ret, j - 1)
            End If
            Next j
        End If
        'eliminate superfluous spaces around "CT-"
        ret = "CT-" & ret
        StartSht.Range("C" & k).Value = ret
    End If
Next k

EDIT: CT issues

It is now

Start:           Output:
CT-0087 (TC-7988)    CT-0087
CT-0067-02           CT-0067
CT-0076-REV01        CT-0076
CT-0098-1 A          CT-0098

I want it to be

Start:           Desired Output:
CT-0087 (TC-7988)    CT-0087
CT-0067-02           CT-0067-02
CT-0076-REV01        CT-0076-01
CT-0098-1 A          CT-0098-1

So there should always be a "-" and a maximum of 2 numbers to grab, but I would only want it to grab it if the dash is immediately following (CT-0087 (TC-7988) should not be CT-0087-79) and I do not know how to throw an exception for that particular issue. Ideas?

ChipsLetten

There are a couple things that I would do differently.

  1. I would store the result of the Instr function in a variable
  2. When you find the first "TL" entry you keep those characters as part of your answer. But that means you need to worry about spaces and hyphens between the text and the numbers. I would look for the first "TL" and then from that position look at successive characters looking for the first numeric one. This is the start of your number. Anything before that character should get removed.
  3. To format a number with leading zeroes you can use the Format$ function. To remove leading zeroes, you can convert the string into a long using CLng.
  4. It looks like you might need similar code for later in your code when you look for "CT" so I suggest creating a function that returns the number.

Here is the function:

Public Function ExtractNumberWithLeadingZeroes(ByRef theWholeText As String, ByRef idText As String, ByRef numCharsRequired As Integer) As String

' Finds the first entry of idText in theWholeText
' Returns the first number found after idText formatted
' with leading zeroes

Dim i As Integer
Dim j As Integer
Dim thisChar As String
Dim returnValue As String
Dim tmpText As String
Dim firstPosn As Integer
Dim secondPosn As Integer

    returnValue = ""
    firstPosn = InStr(1, theWholeText, idText)
    If firstPosn > 0 Then
        ' remove any text before first idText, also remove the first idText
        tmpText = Mid(theWholeText, firstPosn + Len(idText))
        'if more than one idText value, delete everything after (and including) the second idText
        secondPosn = InStr(1, tmpText, idText)
        If secondPosn > 0 Then
            tmpText = Mid(tmpText, 1, secondPosn)
        End If
        ' Find first number
        For j = 1 To Len(tmpText)
            If IsNumeric(Mid(tmpText, j, 1)) Then
                tmpText = Mid(tmpText, j)
                Exit For
            End If
        Next j
        ' Find where the numbers end
        returnValue = tmpText
        For j = 1 To Len(returnValue)
            thisChar = Mid(returnValue, j, 1)
            If Not IsNumeric(thisChar) Then
                returnValue = Mid(returnValue, 1, j - 1)
                Exit For
            End If
        Next j
        'force to numCharsRequired numbers if too short; add 0s immediately after idText
        'force to numCharsRequired numbers if too long; eliminate 0s immediately after idText
        ' The CLng gets rid of leading zeroes and the Format$ adds any required up to numCharsRequired chars
        returnValue = Format$(CLng(returnValue), String(numCharsRequired, "0"))
    End If

    ExtractNumberWithLeadingZeroes = returnValue

End Function

You call this function like this:

ret = ExtractNumberWithLeadingZeroes(str, "TL", 6)

And you get something like "000487".

Your original block of code becomes:

'force length of TL/CT to be 6/4 numbers long, eliminate spaces
Dim str As String, ret As String, k As Integer

For k = 2 To StartSht.Range("C2").End(xlDown).Row
    ret = ""
    str = StartSht.Range("C" & k).Value

    ret = ExtractNumberWithLeadingZeroes(str, "TL", 6)
    If ret <> "" Then
        StartSht.Range("C" & k).Value = "TL-" & ret
    Else

        'for CT numbers
        ret = ExtractNumberWithLeadingZeroes(str, "CT", 4)
        If ret <> "" Then
            StartSht.Range("C" & k).Value = "CT-" & ret
        End If

    End If
Next k

EDIT: OP clarified his position so I've re-written the ExtractNumberWithLeadingZeroes function and included the new version below:

Public Function ExtractNumberWithLeadingZeroes(ByRef theWholeText As String, ByRef idText As String, ByRef numCharsRequired As Integer) As String

' Finds the first entry of idText in theWholeText
' Returns the first number found after idText formatted
' with leading zeroes

Dim returnValue As String
Dim extraValue As String
Dim tmpText As String
Dim firstPosn As Integer
Dim secondPosn As Integer
Dim ctNumberPosn As Integer

    returnValue = ""
    firstPosn = InStr(1, theWholeText, idText)
    If firstPosn > 0 Then
        ' remove any text before first idText, also remove the first idText
        tmpText = Mid(theWholeText, firstPosn + Len(idText))
        'if more than one idText value, delete everything after (and including) the second idText
        secondPosn = InStr(1, tmpText, idText)
        If secondPosn > 0 Then
            tmpText = Mid(tmpText, 1, secondPosn)
        End If
        returnValue = ExtractTheFirstNumericValues(tmpText, 1)
        If idText = "CT" Then
            ctNumberPosn = InStr(1, tmpText, returnValue)
            ' Is the next char a dash? If so, must include more numbers
            If Mid(tmpText, ctNumberPosn + Len(returnValue), 1) = "-" Then
                ' There are some more numbers, after the dash, to extract
                extraValue = ExtractTheFirstNumericValues(tmpText, ctNumberPosn + Len(returnValue))
            End If
        End If
        'force to numCharsRequired numbers if too short; add 0s immediately after idText
        'force to numCharsRequired numbers if too long; eliminate 0s immediately after idText
        ' The CLng gets rid of leading zeroes and the Format$ adds any required up to numCharsRequired chars
        If returnValue <> "" Then
            returnValue = Format$(CLng(returnValue), String(numCharsRequired, "0"))
            If extraValue <> "" Then
                returnValue = returnValue & "-" & extraValue
            End If
        End If
    End If

    ExtractNumberWithLeadingZeroes = returnValue

End Function

Private Function ExtractTheFirstNumericValues(ByRef theText As String, ByRef theStartingPosition As Integer) As String

Dim i As Integer
Dim j As Integer
Dim tmpText As String
Dim thisChar As String

    ' Find first number
    For i = theStartingPosition To Len(theText)
        If IsNumeric(Mid(theText, i, 1)) Then
            tmpText = Mid(theText, i)
            Exit For
        End If
    Next i
    ' Find where the numbers end
    For j = 1 To Len(tmpText)
        thisChar = Mid(tmpText, j, 1)
        If Not IsNumeric(thisChar) Then
            tmpText = Mid(tmpText, 1, j - 1)
            Exit For
        End If
    Next j

    ExtractTheFirstNumericValues = tmpText

End Function

Collected from the Internet

Please contact [email protected] to delete if infringement.

edited at
0

Comments

0 comments
Login to comment

Related

From Dev

VBA - throwing exceptions for specific errors in working code, IsNumeric issue?

From Dev

VBA - throwing exceptions to grab more numbers for output errors

From Dev

Duplicating code for throwing exceptions

From Dev

Handle MediaPlayer exceptions from throwing infinite errors

From Dev

Handle MediaPlayer exceptions from throwing infinite errors

From Dev

npm install not working, throwing errors

From Dev

Trouble deleting objects from JSON array if it matches a specific condition using PHP. Code is throwing errors

From Dev

I copy & pasted working code into my IDE - now Python is throwing tons of errors

From Dev

Markdown-it not working, Throwing errors on page load

From Dev

Complex regex sed replacement not working but not throwing errors

From Dev

Acces VBA code combination not working, issue with exit sub?

From Dev

Why is my sql code throwing errors

From Dev

delete code in trigger throwing up errors oracle

From Dev

Using @Valid is throwing exceptions & not working in basic Spring 3.0 MVC program

From Dev

Using @Valid is throwing exceptions & not working in basic Spring 3.0 MVC program

From Dev

Python throwing an error despite the code working correctly

From Dev

VBA IsNumeric going WILD

From Dev

Searching text file for a words not working and not throwing any errors

From Dev

No syntax errors, still code not working

From Dev

Android - Errors in code that should be working

From Dev

excel VBA code not working

From Dev

VBA code not working in UFT

From Dev

Excel VBA throwing a cache issue error 1004 with Workbooks.Open?

From Dev

Why is Swift 3 code that's never executed throwing runtime errors?

From Dev

Why is Swift 3 code that's never executed throwing runtime errors?

From Dev

The point of throwing exceptions

From Dev

Join attempt throwing exceptions

From Dev

Throwing own exceptions

From Dev

LayoutInflater throwing exceptions

Related Related

  1. 1

    VBA - throwing exceptions for specific errors in working code, IsNumeric issue?

  2. 2

    VBA - throwing exceptions to grab more numbers for output errors

  3. 3

    Duplicating code for throwing exceptions

  4. 4

    Handle MediaPlayer exceptions from throwing infinite errors

  5. 5

    Handle MediaPlayer exceptions from throwing infinite errors

  6. 6

    npm install not working, throwing errors

  7. 7

    Trouble deleting objects from JSON array if it matches a specific condition using PHP. Code is throwing errors

  8. 8

    I copy & pasted working code into my IDE - now Python is throwing tons of errors

  9. 9

    Markdown-it not working, Throwing errors on page load

  10. 10

    Complex regex sed replacement not working but not throwing errors

  11. 11

    Acces VBA code combination not working, issue with exit sub?

  12. 12

    Why is my sql code throwing errors

  13. 13

    delete code in trigger throwing up errors oracle

  14. 14

    Using @Valid is throwing exceptions & not working in basic Spring 3.0 MVC program

  15. 15

    Using @Valid is throwing exceptions & not working in basic Spring 3.0 MVC program

  16. 16

    Python throwing an error despite the code working correctly

  17. 17

    VBA IsNumeric going WILD

  18. 18

    Searching text file for a words not working and not throwing any errors

  19. 19

    No syntax errors, still code not working

  20. 20

    Android - Errors in code that should be working

  21. 21

    excel VBA code not working

  22. 22

    VBA code not working in UFT

  23. 23

    Excel VBA throwing a cache issue error 1004 with Workbooks.Open?

  24. 24

    Why is Swift 3 code that's never executed throwing runtime errors?

  25. 25

    Why is Swift 3 code that's never executed throwing runtime errors?

  26. 26

    The point of throwing exceptions

  27. 27

    Join attempt throwing exceptions

  28. 28

    Throwing own exceptions

  29. 29

    LayoutInflater throwing exceptions

HotTag

Archive