CODEWITHSUNDEEP
excelvbastringnumbersextract
Bear
Bear

Reputation: 1

Need Excel VBA program that will extract two $numbers from column A and place them in Col B&C

I found some python code on this site via a google search and adopted it for Excel VBA, but it doesn't quite work. Column A has multiple rows with two numbers. The numbers always follow a dollar sign and there are always only two numbers. Some numbers can include a "," or a ".". I'd like to place the numbers in column B & C, respectively. It separates incorrectly the numbers into different columns if they include a "," or "." and it doesn't capture the second number.

Here are two examples of a text string to extract $ numbers:

I coded Excel VBA a lot 10 years ago, but very rusty. I know there must be a way to find the "$" and capture numbers after that, then continue onto the second number.

Here's the code, TIA:

Sub ExtractNum()
    
    Dim count, count1 As Integer
    Dim holder As String
    Dim sample, smallSample As String
    Dim r As Integer
    Dim c As Integer
    r = 1
    c = 1
    
    
    Do While Sheet1.Cells(r, c) <> ""
        count = 0
        count1 = 1
        sample = Sheet1.Cells(r, c)
        holder = ""
        Do While count <> Len(sample)
            smallSample = Left(sample, 1)
            If smallSample = "0" Or smallSample = "1" Or smallSample = "2" Or smallSample = "3" Or smallSample = "4" Or smallSample = "5" Or smallSample = "6" Or smallSample = "7" Or smallSample = "8" Or smallSample = "9" Then
                holder = holder & smallSample
            Else
                If holder <> "" Then
                    Sheets(1).Cells(r, c + count1).Value = holder
                    count1 = count1 + 1
                End If
                holder = ""
            End If
            sample = Right(sample, Len(sample) - 1)
        
        Loop
        r = r + 1
    Loop
End Sub

Upvotes: 0

Views: 75

Answers (3)

taller
taller

Reputation: 18943

The script was developed and tested using the sample data provided in the original post. You may need to adjust it if your actual data follows a different pattern.

btw, Loading data into an array is an efficient approach when working with large datasets.

Sub Demo()
    Dim i As Long, j As Long, c As Range, arr
    For Each c In Range("A1").CurrentRegion
        arr = Split(c.Text, "$") ' split the text by $
        If UBound(arr) > 0 Then 
            For j = 1 To UBound(arr)
                If j > 2 Then Exit For ' only take the first two numbers
                c.Offset(, j).Value = "'" & Split(arr(j))(0) ' populate cell
            Next
        End If
    Next
End Sub

enter image description here

Upvotes: 2

Mayukh Bhattacharya
Mayukh Bhattacharya

Reputation: 27438

If one is using MS365 then this is quite achievable using TEXTSPLIT() as well, however if not then can ignore and stick to the VBA solutions as posted above by Taller and Tim Williams Sir, perhaps

enter image description here

• Formula used in cell B2

=--DROP(TEXTSPLIT(A2,{" to "," from "}),,1)

• Or:

=LET(
     a,--TEXTSPLIT(A2," "),
     TOROW(a/ISNUMBER(a),2))

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166755

Like this maybe:

Sub ExtractNum()
    Dim count As Long, c As Range, pos As Long 'prefer long over integer
    Dim sample As String, num As String
    
    Set c = Sheet1.Cells(1, 1) 'starting point
    Do While Len(c.Value) > 0
        c.Offset(0, 1).Resize(1, 5).ClearContents 'clear previous attempts
        count = 1
        sample = c.Value & " " 'to avoid running off the end of the string when looping...
        pos = InStr(1, sample, "$") 'find a $
        Do While pos > 0
            num = GetNumber(sample, pos + 1)
            If Len(num) > 0 Then 'got some text?
                c.Offset(0, count).Value = num
                count = count + 1
            End If
            pos = InStr(pos + 1, sample, "$")
        Loop
        Set c = c.Offset(1) 'next row down
    Loop
End Sub

'extract a run of digits, period or comma from `txt`, starting at `posStart`
Function GetNumber(txt As String, ByVal posStart As Long) As String
    Dim c As String
    c = Mid(txt, posStart, 1)
    Do While c Like "[0-9.,]"
        GetNumber = GetNumber & c
        posStart = posStart + 1
        c = Mid(txt, posStart, 1)
    Loop
End Function

Upvotes: 1

Related Questions