VBA support :- Need data all in the whole number

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
961
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Team,

I have huge data in excel from A1 to IV349 and in between, i have the number 21%,.012
so i need all numbers in the whole number columns A and B are the row data and the output i need in columns E and F green highlighted data

I need data wiht no letters


Book1
ABCDEF
115201520
2916916
316191619
412181218
52129B2129
613161316
70.150.171517
816151615
914171417
1010111011
110.090.16916
1211151115
13913913
140.10.131013
150.160.171617
160.090.0999
170.1925%B1925
180.090.0898
190.150.131513
200.040.0949
2117191719
2210111011
2323%B0.212321
240.120.171217
250.1421%BD1421
260.090.11911
270.120.161216
280.090.1910
2917191719
30118118
3119211921
Sheet1
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
See if you use this macro (to be pasted in a standard module) in your real project. Be aware that as it is the resulting numbers will overwrite your original data so use a copy of your file for testing. Some other comments in the macro.
Before use remember to activate reference to VBScript Regular Expressions in menu Tools of VBE, it is needed by function RegExp.
VBA Code:
Option Explicit
Sub Extract_Numbers()
    Dim lastCol As Long
    Dim lastRow As Long
    Dim pCol   As Long
    Dim pRow   As Long
    lastCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column    'detect last used column
    For pCol = 1 To lastCol                                         'column in progress
        lastRow = Cells(Rows.Count, pCol).End(xlUp).Row             'detect last used row in column
        For pRow = 1 To lastRow                                     'row in progress
            Cells(pRow, pCol) = GetNumbers(Cells(pRow, pCol))       'substitutes contents of original cells
        Next pRow
    Next pCol
End Sub

Private Function GetNumbers(ByVal txt As String) As String
    'needs reference to Microsoft VBScript Regular Expressions
    Dim num      As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\d+"
        txt = Replace(txt, ".", "")
        If txt Like ("0?") Then txt = txt & "0"   'detects cases such as 0.1 to 0.9 (without trailing zero)
        For Each num In .Execute(txt)
            GetNumbers = GetNumbers & num.Value
        Next
    End With
End Function
 
Last edited:
Upvote 0
In Power Query:

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    char2 = List.Accumulate({"1".."9"}, {}, (s,c)=> s & {"." & c}),
    lst = List.Transform(Table.ToColumns(Source), each List.Transform(_, (x)=> let t = Text.From(x) in if List.Contains(char2, Text.End(t,2)) then t & "0" else t)),
    tbl = Table.FromColumns(List.Transform(lst, each List.Transform(_, (x)=> Number.From(Text.Select(x , {"0".."9"})))))
in
    tbl

Book1
ABCDEF
1Column1Column2Column1Column2
215201520
3916916
416191619
512181218
62129B2129
713161316
80.150.171517
916151615
1014171417
1110111011
120.090.16916
1311151115
14913913
150.10.131013
160.160.171617
170.090.0999
180.1925%B1925
190.090.0898
200.150.131513
210.040.0949
2217191719
2310111011
2423%B0.212321
250.120.171217
260.1421%BD1421
270.090.11911
280.120.161216
290.090.1910
3017191719
31118118
3219211921
33
Sheet1
 
Upvote 0
There are already two options, let me add a third one based on formula
I understood that only columns A & B need to be evaluated and the result be written in E & F
So set in E2 the following formula:
Excel Formula:
=LET(Num,A2,XX,IF(AND(MID(Num,2,1)=".",LEN(Num)<4),10,1),Seq,SEQUENCE(LEN(Num),,1),crt,MID(Num,Seq,1),TEXTJOIN("",TRUE,IF(ISNUMBER(--crt),crt,""))*XX)
Copy E2 in F2; then copy E2:F2 down till E349
 
Upvote 0
Thanks for the positive feedback(y), glad we were able to be of some help.
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,885
Members
452,364
Latest member
springate

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top