Extract an alphanumeric from sentence

Question

I would like to have an VBA to extract an alphanumeric value from a column G which is a sentence.

This sentence is generally a comment. So it includes characters and numbers.

The value always starts with AI0 and ends with 0. This can be 11 to 13 digits long. Sometimes the number is mentioned in the comment as AI038537500, also sometimes as AI038593790000.

I have researched through almost all the websites, but have not found any case like this. I know about the formulas, left, right, mid but in my case, it doesn't apply.

Any lead would be appreciable.

Answer 1

can you give this a try? I think it should do the job, also you should ammend the code with the column values, I tested it with the comments being in column C, while the code will be written in column D.

Option Explicit

    Sub FindValue()
    Dim i As Long
    Dim lastrow As Long
    Dim lFirstChr As Long
    Dim lLastChr As Long
    Dim CodeName As String

    lastrow = activesheet.Range("c" & Rows.Count).End(xlUp).Row
    ' gets the last row with data in it

    For i = 1 To lastrow
    ' shuffles through all cell in data

    lFirstChr = InStr(1, Cells(i, 3), "A10") ' gets the coordinate of the first instance of "A10"

    If lFirstChr = 0 Then GoTo NextIteration

    lLastChr = InStr(lFirstChr, Cells(i, 3), " ") ' gets the coordinate of the first instansce of space after "A10"

      If lLastChr = 0 Then 'if there is no space after A10 then sets lastchr to the lenght of the string

            lLastChr = Len(Cells(i, 3))

        End If

    CodeName = Mid(Cells(i, 3).Value, lFirstChr, lLastChr - lFirstChr) ' extracts the codename from the string value

    Range("d" & i).Value = CodeName

    Goto NextTteration


    NextIteration:
       Next i

    End Sub

Answer 2

Why not give something like the following a try?

Sub findMatches()

    Dim strLength As Integer
    Dim i As Long

    For i = 1 To Rows.Count

        Dim AllWords As Variant
        AllWords = Split(Cells(i, 7).Value, " ")

        For Each Item In AllWords


            strLength = Len(Item)
            If strLength > 0 And strLength <= 13 And Item Like "A10*?#" Then
                Cells(i, 8) = Item
            End If

        Next

    Next i

End Sub

Test Cases:

1. I am apple and my batch number is: A10545440 so incase you needed to know

Result: A10545440

2. Some random comment… A20548650

Result: NO RESULT

3. A101234567891 is an awesome alphanumeric combo

Result: A101234567891

4. Another random comment… A10555

Result: A10555

Notice: The above example covers cases where the alphanumeric combo, starting with A10 is either:

• In the middle of a sentence, or
• Beginning of a sentence, or
• At the end of a sentence

Also note: right now it is set to go through ALL the rows... so if you want to limit that, change the Rows.Count in the For statement to whatever your set limit is.

EDIT: In the above code, I am explicitly asking it to look in column G

Answer 3

You may try something like this...

Place the following User Defined Function on a Standard Module and then use it on the sheet like

=GetAlphaNumericCode(A1)

UDF:

Function GetAlphaNumericCode(rng As Range)
Dim Num As Long
Dim RE As Object, Matches As Object
Set RE = CreateObject("VBScript.RegExp")
With RE
   .Global = False
   .Pattern = "AI\d{9,}0"
End With
If RE.Test(rng.Value) Then
   Set Matches = RE.Execute(rng.Value)
   GetAlphaNumericCode = Matches(0)
Else
   GetAlphaNumericCode = "-"
End If
End Function