VBA - throwing exceptions for specific errors in w

Question

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?

Answer 1

If the TL-###### is always going to be the first nine characters you could use.

If the dash isn't consistently the 3rd char i have changed it a bit.

Dim iIndex As Integer

'If there is a space between TL and - "TL -" let's get rid of it.
iIndex = InStr(str, " ")
If iIndex = 3 Then
    str = Replace(str, " ", "", 1, 1)
End If

If Left(str, 2) = "TL" Then
   TL = Left(str, 9)
   TL = padZeros(TL, 6)
   StartSht.Range("C" & k).Value = TL
ElseIf Left(str, 2) = "CT" Then
   CT = Left(str, 7)
   CT = padZeros(CT, 4)
   StartSht.Range("C" & k).Value = CT
Else
   MessageBox.Show ("We got a string we didn't expect.")
End If

For your short numbers add a function like

Function padZeros(szinput As String, lenght As Integer) As String
    Dim temp As String

    temp = Trim(Right(szinput, 6))
    temp = Replace(temp, "-", "")
    temp = Replace(temp, " ", "")
    szinput = Left(szinput, 3)

    Do While lenght > Len(temp)
        temp = "0" & temp
    Loop
    padZeros = szinput & temp
End Function

Answer 2

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