Excel-VBA: Get numeric value from alphanumeric

Question

I have a column (Column A) which has alphanumeric text and I want to read it and write it back to another column (Column C). The code is;

Sub getnumber()

'Define Variable
Dim anicode As Variant
Dim n As Long
Dim lastrowdata As Long

'Data Location
Sheets("Sheet1").Activate
lastrowdata = range("A2").end(xlDown).Row - 1

'Redefine Array
ReDim anicode(lastrowdata)

'Read Data
For n = 1 To lastrowdata
  anicode(n) = Sheets("Sheet1").Cells(1 + n, 1)
Next n

'Altering Data
For n = 1 To lastrowdata
  If IsNumeric(anicode(n)) Then
     anicode(n) = NumericOnly
  Else
  End If
Next n

'Write Data
For n = 1 To lastrowdata
  Sheets("Sheet1").Cells(1 + n, 3) = anicode(n)
Next n

End Sub

I am stuck at the Altering Data part where I want to get value from the text only. I only new in VBA and only know IsNumeric function currently. In the column A, the data is alphanumeric and is random, where it might have dash (-) or space ( ) or even jumble up with alphabet such as S2 or X4. There is possibility that the data is only numeric (since the data is long ~8k and will be growing).

As examples; in Column A, I have

R1-Adapa S2
R2-Adapa S2
R3-Omis 14
R4-189

and in Column C, I would like to have the numeric only

R1-002
R2-002
R3-014
R4-189

Appreciate if any possible function or any opinion regarding my problems or on my code. Thanks stackoverflow.com

Answer 1

I would do the macro a bit differently

• Read the original data into a vba macro for speed of processing
• Use regular expressions to obtain the relevant portion of the string
• Format the terminal digits to have appropriate number of leading zero's
• Write the results into another VBA array -- again for speed.
• Write and format the results back to the worksheet.
• Format the results as desired

For example:

Option Explicit
Sub getnumber()
    Dim wsSrc As Worksheet
    Dim vSrc As Variant, vRes As Variant
    Dim rRes As Range
    Dim I As Long

Set wsSrc = Worksheets("sheet1")
With wsSrc

'set results area
    Set rRes = .Cells(1, 3)

'Read data into array for faster processing
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'create results array
ReDim vRes(1 To UBound(vSrc), 1 To 1)

'Fill vres with the converted data
For I = 1 To UBound(vRes, 1)
    vRes(I, 1) = reFormat(vSrc(I, 1))
Next I

'Size the results range
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1))

'Clear the area and write the new data
With rRes
    .EntireColumn.Clear

   'In case a value is solely numeric, as in A5 of example
    .NumberFormat = "@"

    .Value = vRes
    .EntireColumn.AutoFit
    .Style = "Output"
End With

End Sub



Function reFormat(ByVal S As String) As String
    Dim RE As Object, MC As Object

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .MultiLine = True
    .Pattern = "(^\D\d+-)?\D*(\d+)"
    If .test(S) = True Then
        Set MC = .Execute(S)
        With MC(0)
            reFormat = .submatches(0) & Format(.submatches(1), "000")
        End With
    End If
End With

End Function

Here is a brief description of the Regular Expression Pattern:

(^\\D\\d+-)?\\D*(\\d+)

(^\D\d+-)?\D*(\d+)

Options: Case sensitive; ^$ match at line breaks

• Match the regex below and capture its match into backreference number 1 (^\\D\\d+-)?
  • Between zero and one times, as many times as possible, giving back as needed (greedy) ?
  • Assert position at the beginning of the string ^
  • Match a single character that is NOT a “digit” \\D
  • Match a single character that is a “digit” \\d+
    • Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
  • Match the character “-” literally -
• Match a single character that is NOT a “digit” \\D*
  • Between zero and unlimited times, as many times as possible, giving back as needed (greedy) *
• Match the regex below and capture its match into backreference number 2 (\\d+)
  • Match a single character that is a “digit” \\d+
    • Between one and unlimited times, as many times as possible, giving back as needed (greedy) +

Created with RegexBuddy

Answer 2

Using that source I came up with :

=LEFT(A1,3)&TEXT(MID(SUMPRODUCT(MID(0&A1,LARGE(INDEX(ISNUMBER(--MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1))*ROW(INDIRECT("1:"&LEN(A1))),0),ROW(INDIRECT("1:"&LEN(A1))))+1,1)*10^ROW(INDIRECT("1:"&LEN(A1)))/10),2,LEN(A1)),"000")

Which gives me the expected results from provided examples.

Answer 3

In order to complete the task, you'll need to additional functions, which will make code easier and cleaner:

First, function that extracts only numbers from given string:

Function OnlyNumbers(word As String) As String
    Dim i As Long, ascIdx As Long
    OnlyNumbers = ""
    For i = 1 To Len(word)
        'if it's letter then append it to a returned word
        If IsNumeric(Mid(word, i, 1)) Then
            OnlyNumbers = OnlyNumbers + Mid(word, i, 1)
        End If
    Next
End Function

Secodnly, we need function, that will ad leading zeros in case we need that:

Function LeadingZeros(word As String, outputLength As Long) As String
    Dim i As Long
    LeadingZeros = ""
    For i = 1 To outputLength - Len(word)
        LeadingZeros = LeadingZeros + "0"
    Next
    LeadingZeros = LeadingZeros + word
End Function

Eventually, we write a sub, which does the copying:

Sub CopySpecial()
    Dim ws As Worksheet, lastRow As Long, i As Long, hyphenIdx As Long
    'always set reference to main sheet, so you can use it in range references
    Set ws = Sheets("Arkusz1")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastRow
        code = Cells(i, 1).Value
        hyphenIdx = InStr(1, code, "-")
        'set the text formatting, so leading zeroes won't be truncated
        Cells(i, 3).NumberFormat = "@"
        If hyphenIdx = 0 Then
            Cells(i, 3).Value = LeadingZeros(OnlyNumbers(Cells(i, 1).Value), 3)
        Else
            Cells(i, 3).Value = Mid(code, 1, hyphenIdx) + LeadingZeros(OnlyNumbers(Mid(code, hyphenIdx + 1)), 3)
        End If
    Next

End Sub

Answer 4

Following array formula ( CTRL + SHIFT + ENTER ) also can be used

=TEXT(MAX(IFERROR(MID(" "&A3,ROW($A$1:$A$99),COLUMN($A$1:$CU$1))+0,0)),"000")

Note: Formula is limited to 99 characters but can be easily expanded to if cells with more than 99 characters are present.