1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA: Extract Amt from String

Discussion in 'VBA Macros' started by Monty, Jul 24, 2017.

  1. Monty

    Monty Well-Known Member

    Messages:
    802
    Hello Everyone.

    Little tricky one tried all the combinations including text to columns and with vba for the below attached file.

    I have 85 k rows need to loop through each row to get the output only the amount.

    Taken sample text which is most commonly repeated onces in my data.

    It would be great if we can crack. Thanks.

    upload_2017-7-24_23-39-44.png

    Attached Files:

  2. vletm

    vletm Well-Known Member

    Messages:
    2,708
    Something like this ?
    There were 4 kind of 'amounts', none negative(?).
    Press [GET]

    Attached Files:

    Thomas Kuriakose and Monty like this.
  3. Monty

    Monty Well-Known Member

    Messages:
    802
    Hey vletm..

    Hope you are doing good..

    There are 4 type as per the sample i investigated it may be more...but lukly all the amounts will be at the end of the string...

    for some strings there is no amount..

    in attached file ....Macro missing in the file...
  4. Monty

    Monty Well-Known Member

    Messages:
    802
    Sorry i picked up the wrong file...
  5. vletm

    vletm Well-Known Member

    Messages:
    2,708
    No matter of ending ... just 'types' matter!
    Marco do not missing!
    ... Focus!
    Monty likes this.
  6. Monty

    Monty Well-Known Member

    Messages:
    802
    Really like the code written smart and quick..

    But this may not be the case always

    chks(0) = "USD." ' What if GPB having only dot.
    chks(1) = "USD-" ;What if USD have colon.
    chks(2) = "GPB:" ' What if CNY having space
    chks(3) = ".CNY"

    Just wanted to understand...how we can tweek this!
  7. YasserKhalil

    YasserKhalil Active Member

    Messages:
    651
    Hello Mr. Monty
    Here's my poor attempt.. Till experts offer more
    Code (vb):
    Sub Test()
        Dim arr        As Variant
        Dim x          As Variant
        Dim str        As String
        Dim i          As Long

        arr = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 2).Value

        For i = LBound(arr, 1) To UBound(arr, 1)
            If InStr(arr(i, 1), "USD") > 0 Then
                str = "USD"
            ElseIf InStr(arr(i, 1), "GPB") > 0 Then
                str = "GPB"
            ElseIf InStr(arr(i, 1), "CNY") > 0 Then
                str = "CNY"
            Else
                str = ""
            End If

            If str <> "" Then x = ExtractNumber(CStr(Split(arr(i, 1), str)(1)), 1): arr(i, 2) = CStr(x)
        Next i

        Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End Sub

    Function ExtractNumber(rCell, Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double
        Dim vVal        As Variant
        Dim vVal2      As Variant
        Dim iCount      As Integer
        Dim i          As Integer
        Dim iLoop      As Integer
        Dim sText      As String
        Dim strNeg      As String
        Dim strDec      As String
        Dim lNum        As String

        sText = rCell

        If Take_decimal = True And Take_negative = True Then
            strNeg = "-"
            strDec = "."
        ElseIf Take_decimal = True And Take_negative = False Then
            strNeg = vbNullString
            strDec = "."
        ElseIf Take_decimal = False And Take_negative = True Then
            strNeg = "-"
            strDec = vbNullString
        End If

        iLoop = Len(sText)
        For iCount = iLoop To 1 Step -1
            vVal = Mid(sText, iCount, 1)
            If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then
                i = i + 1
                lNum = Mid(sText, iCount, 1) & lNum

                If IsNumeric(lNum) Then
                    If CDbl(lNum) < 0 Then Exit For
                Else
                    lNum = Replace(lNum, Left(lNum, 1), "", , 1)
                End If
            End If

            If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))
        Next iCount

        ExtractNumber = CDbl(lNum)
    End Function
    Thomas Kuriakose, r2c2 and Monty like this.
  8. vletm

    vletm Well-Known Member

    Messages:
    2,708
    Monty
    You can add as many those as needed.
    Just modify code as needed.
    I pick those from Your sample!
    If 'something' gotta find then 'something' gotta know!
    There have to be rules!
    ... and as I wrote, Your sample shows that NO negative amounts!
    Monty likes this.
  9. Monty

    Monty Well-Known Member

    Messages:
    802
    Yes...Thank you so very much!...need to investigate how many currency available and implement code provided...Will surly get back to you on this...Awsome!
  10. Monty

    Monty Well-Known Member

    Messages:
    802
    YasserKhalil...This is really a poor attempt..But made my day Awesome code...works like a charm...Tried with all the combinations to see whether it works..No words..You are champ.

    Will check at work...how many currency available based on the historic data to crack this.Onces again thank you so very much!



    YasserKhalil likes this.
  11. YasserKhalil

    YasserKhalil Active Member

    Messages:
    651
    You're welcome my friend. Glad I can offer some help
    And it will be easier for you to adapt other currencies ..
    Regards
    Monty likes this.
  12. Monty

    Monty Well-Known Member

    Messages:
    802
    Yes Boss.
    Going to be easy to adopt currencies as you said...But just thinking instead of investigating what other currencies available...Better to include all the currencies. To be safe side.

    But again If condition is going to lengthy one....May be need use some array to store all...?

    Your code is Masterpiece!
    YasserKhalil likes this.
  13. vletm

    vletm Well-Known Member

    Messages:
    2,708
    Monty
    1) Are You sure that those 'String'-parts do not have texts like 'USD' or any other currency are You? That's why those 'mystic' pre/past characters would be need.
    2) Your sample shows that no negative amounts!
    3) Just one if condition needs to find which currency (or of course many if want to do so).
    4) Send those 85k rows here, then You could see how to get those amounts out!
  14. Marc L

    Marc L Excel Ninja

    Messages:
    3,092
    Hi !

    With a complete and crystal clear presentation,
    maybe an easy way is possible without taking care of any currency …

    All numbers to extract have a dot ?

    Way 1 : check from end of string first character which is not a number
    or a second dot. If is it not the last character and different from a space,
    so there is a number to extract …

    Way 2 : use a regular expression …
  15. vletm

    vletm Well-Known Member

    Messages:
    2,708
    Marc L - hmm ..
    1) like from end of strings form sample data:
    FOR JUNE 2017
    2017-04.CNY46874.102896

    2) As I wrote:

    Are You sure that those 'String'-parts do not have texts like 'USD' or any other currency...?
    >> Without data ... challenge!
  16. Marc L

    Marc L Excel Ninja

    Messages:
    3,092


    No issue with your sample whatever the way of my previous post …​
  17. vletm

    vletm Well-Known Member

    Messages:
    2,708
    Marc L ... recheck #1 -- There is that sample data -- no issue? Okay
  18. Marc L

    Marc L Excel Ninja

    Messages:
    3,092

    No issue on my side with sample workbook, just follow way 1 logic,
    that needs around 30 codelines without checking any currency …​
  19. Chihiro

    Chihiro Well-Known Member

    Messages:
    3,456
    Assuming following pattern is what is needed to be extracted.
    digits[dot]digits

    Pattern then is "\d+\.\d+". Didn't consider negative value as sample had "-550.600" but extracted as "550.600"

    Code (vb):
    Sub Demo()
    Dim cel As Range
    With CreateObject("VBScript.RegExp")
        .Pattern = "\d+\.\d+"
        For Each cel In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
            If .Test(cel.Value) Then cel.Offset(, 2) = CDbl(.Execute(cel.Value)(0))
        Next
    End With
    End Sub
    If not familiar with RegEx, you can use following site to test patterns.
    https://regex101.com/
  20. Marc L

    Marc L Excel Ninja

    Messages:
    3,092

    Way 2 in previous post, for advanced users.

    Way 1 is a child logic so at beginner level …
  21. Chihiro

    Chihiro Well-Known Member

    Messages:
    3,456
    I'm not so sure that RegEx is for advanced users. It really does, simplify coding logic and is quite simple to use.

    For the other way, I'd likely do something like below.
    Code (vb):
    Sub Demo()
    Dim cel As Range, x As String
    For Each cel In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        For i = Len(cel.Value) To 1 Step -1
            If IsNumeric(Mid(cel.Value, i, 1)) Or Mid(cel.Value, i, 1) = "." Then
                If Mid(cel.Value, i, 1) = "." Then
                    x = IIf(InStr(1, x, ".") > 0, "" & x, Mid(cel.Value, i, 1) & x)
                Else
                    x = Mid(cel.Value, i, 1) & x
                End If
            Else
                Exit For
            End If
        Next
        If InStr(1, x, ".") > 0 Then
            cel.Offset(, 2) = CDbl(x)
        End If
        x = ""
    Next
    End Sub
  22. Marc L

    Marc L Excel Ninja

    Messages:
    3,092

    For system with a non dot decimal separator,
    mod codeline #16 as cel.Offset(, 2).Value = x
    in order to avoid a type error 'cause of CDbl …​
    Monty, YasserKhalil and Chihiro like this.
  23. r2c2

    r2c2 Member

    Messages:
    94
  24. vletm

    vletm Well-Known Member

    Messages:
    2,708
    This could make many ways, correct.
    But many things depends about that data and wanted output.
    'Short data' and ... clear output.
    As I have tried to verify from the #2 Reply.
    Original wanted output has only positive amounts (550.600 or -550.6).
    Screen Shot 2017-07-27 at 11.13.04.png
    Screen Shot 2017-07-27 at 11.13.17.png
    I 'think' that is mistake, but wanted is wanted!
    Other, what would miss from original output is that 'Currency'-code.
    That was't wanted ... but is output useful without it ...only one knows.
    I cannot use Power Query, that's why nice to see how to use it too.
    Thank You.
  25. Monty

    Monty Well-Known Member

    Messages:
    802

Share This Page