Extracting numericals from alphanumericals by using vb script

Question

I had a column with alphanumeric values and I want to extract numeral's and copy them into adjacent column by using vb script. This is the code I have tried until now but it's giving error in for loop.

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

srcFilePath = "C:\Users\reddy.ku\Desktop\files\Issue.xls"

desFilePath = "C:\Users\reddy.ku\Desktop\files\Book1.xlsx"

Set objWorkbook1 = objExcel.Workbooks.Open(srcFilePath)

Set objWorkbook2 = objExcel.Workbooks.Open(desFilePath)

Set objWorksheet = objWorkbook1.Worksheets(1)

objWorksheet.Activate

Set objRange = objWorkSheet.Range("B1").EntireColumn

objRange.Copy

Set objWorksheet2 = objWorkbook2.Worksheets(1)

objWorksheet2.Activate

Set objRange = objWorksheet2.Range("C1")

objWorksheet2.Paste(objRange)

For i=1 to objWorksheet2.UsedRange.Columns.Count

For j=1 to objWorksheet2.UsedRange.Rows.Count

    if (objWorksheet2.Cells(j,i).Value = Isnumeric) then

objWorksheet2.Range("B1").Paste

Next i

objWorkbook1.Save

objWorkbook1.Close

objWorkbook2.Save

objWorkbook2.Close

please suggest any alternative or any changes in the code

Thanks in advance for your help

Below are the strings look alike in a column.

HDI_144383

HDI_135254

HDI_146750

HDI_147009

DTSample_HDI_146982_TC_Crash

First, read How to Ask and take the tour. Then decide whetehr it is VBscript or VB.NET - cant be both — Ňɏssa Pøngjǣrdenlarp
What have you tried, and how has what you've tried failed? Ideally, you should provide a Minimal, Complete, and Verifiable Example of what you've tried, and include specific information on how it failed, with error messages and/or erroneous output. SO is not a code-writing service; the best questions are those which provide useful information so that those who answer can guide you to devising your own correct answer. See How to Ask a Good Question. — Jeff Zeitlin

Rob Anthony Rob Anthony · Accepted Answer · 2017-08-28T12:23:42

In your spreadsheet, create a module with the following code:

Function MidCode(s As String) As String
i = 1
While Not ((Mid(s, i, 1) >= "0") And (Mid(s, i, 1) <= "9")) And (i <= Len(s))
    i = i + 1
Wend
StartPos = i
While Not ((Mid(s, i, 1) < "0") Or (Mid(s, i, 1) > "9")) And (i <= Len(s))
    i = i + 1
Wend
EndPos = i
MidCode = Mid(s, StartPos, EndPos - StartPos)
End Function

Then, in the column you want to extract the numbers enter:

=MidCode(A1)

And copy this down. If your original data starts in a different place you will need to change the A1 part to match.

Extracting numericals from alphanumericals by using vb script

1 Answers