VBA support :- Need data all in the whole number

[sksanjeev786]

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
	A	B	C	D	E	F
1	15	20			15	20
2	9	16			9	16
3	16	19			16	19
4	12	18			12	18
5	21	29B			21	29
6	13	16			13	16
7	0.15	0.17			15	17
8	16	15			16	15
9	14	17			14	17
10	10	11			10	11
11	0.09	0.16			9	16
12	11	15			11	15
13	9	13			9	13
14	0.1	0.13			10	13
15	0.16	0.17			16	17
16	0.09	0.09			9	9
17	0.19	25%B			19	25
18	0.09	0.08			9	8
19	0.15	0.13			15	13
20	0.04	0.09			4	9
21	17	19			17	19
22	10	11			10	11
23	23%B	0.21			23	21
24	0.12	0.17			12	17
25	0.14	21%BD			14	21
26	0.09	0.11			9	11
27	0.12	0.16			12	16
28	0.09	0.1			9	10
29	17	19			17	19
30	11	8			11	8
31	19	21			19	21
Sheet1

 

[rollis13]

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.

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

 

[JGordon11]

In 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
	A	B	C	D	E	F
1	Column1	Column2		Column1	Column2
2	15	20		15	20
3	9	16		9	16
4	16	19		16	19
5	12	18		12	18
6	21	29B		21	29
7	13	16		13	16
8	0.15	0.17		15	17
9	16	15		16	15
10	14	17		14	17
11	10	11		10	11
12	0.09	0.16		9	16
13	11	15		11	15
14	9	13		9	13
15	0.1	0.13		10	13
16	0.16	0.17		16	17
17	0.09	0.09		9	9
18	0.19	25%B		19	25
19	0.09	0.08		9	8
20	0.15	0.13		15	13
21	0.04	0.09		4	9
22	17	19		17	19
23	10	11		10	11
24	23%B	0.21		23	21
25	0.12	0.17		12	17
26	0.14	21%BD		14	21
27	0.09	0.11		9	11
28	0.12	0.16		12	16
29	0.09	0.1		9	10
30	17	19		17	19
31	11	8		11	8
32	19	21		19	21
33
Sheet1

 

[Anthony47]

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:

=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

 

[sksanjeev786]

Thank you so much Team for your help on this ...!!!

 

[rollis13]

Thanks for the positive feedback, glad we were able to be of some help.