Extract dollar amount from cell

keerthi deva
Apr 1st 2016
Thread is marked as Resolved.

Apr 1st 2016

#1

Hi folks,

I need help for Extracting dollar amounts from cell.

I have done one code but that code extract only 4 digit values !

For example $5000 if my excel have $15000 it track only $15! can any one say where I miss?

Here is my code FYI......

Code

Sub spliter()
'Call Command
Dim r As Range, i As Long, m As Object
    Application.DisplayAlerts = False
    With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
         .Pattern = "(\$\d+\d+)|(\$(\d+(\,\d+)?))|(\b\d+\d+\%)"
        For Each r In Range("C1", Range("C" & Rows.Count).End(xlUp))
            If .test(r.Value) Then
                Set m = .Execute(r.Value)
                For i = 0 To m.Count - 1
                    r(, 2 + i).Value = m(i)
                Next
            End If
        Next
    End With
    Application.DisplayAlerts = True
End Sub

Display More

Thanks & Regards,
dev

skywriter

Professional

Reactions Received

1

Points

5,371

Posts

1,068
Apr 1st 2016
- #2
Re: Extract dollar amount from cell

You should upload a workbook with the data that your regex is not working with.

Just in case you don't know how to do that.

When you click reply there will be a new button labeled go advanced, click on that button then there will be a paperclip icon in the toolbar, click on that icon and follow the instructions.
Bruce :cool:
keerthi deva

Beginner

Points

210

Posts

26
Apr 1st 2016
- #3
Re: Extract dollar amount from cell

Please find the attachment...... :smile:
Files

SAMPLE.xlsm 15.37 kB – 129 Downloads

Apr 1st 2016

#4

Re: Extract dollar amount from cell

Try this. :cool:

Code

Sub spliter()
     'Call Command
    Dim r As Range, i As Long, m As Object
    Application.DisplayAlerts = False
    With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
        .Pattern = "(\$\d+,\d+)"
        For Each r In Range("C1", Range("C" & Rows.Count).End(xlUp))
            If .test(r.Value) Then
                Set m = .Execute(r.Value)
                For i = 0 To m.Count - 1
                    r(, 2 + i).Value = m(i)
                Next
            End If
        Next
    End With
    Application.DisplayAlerts = True
End Sub

Display More

keerthi deva

Beginner

Points

210

Posts

26
Apr 4th 2016
- #5
Re: Extract dollar amount from cell

Perfect! Thank you!:)
skywriter

Professional

Reactions Received

1

Points

5,371

Posts

1,068
Apr 5th 2016
- #6
Re: Extract dollar amount from cell

My pleasure, thanks for the feedback. :cool:
Bruce :cool:
keerthi deva

Beginner

Points

210

Posts

26
Apr 5th 2016
- #7
Re: Extract dollar amount from cell

Is there any way to find dollar amount with their % values based on string?

Please find the attachments!!!!
Files

SAMPLE.xlsm 15.53 kB – 119 Downloads

Apr 5th 2016

#8

Re: Extract dollar amount from cell

I am not a regex expert, but I want to be.
So this seems to work, but may be flawed or there may be a better way to do this.
Try it out and if you have any problems let me know, I'm looking to better my regex knowledge. :cool:

Code

Sub spliter()
     'Call Command
    Dim r As Range, i As Long, m As Object, c As String
    Application.DisplayAlerts = False
    With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
        .Pattern = "(\$\d+,\d+) .+ (\d{0,3}\%?)"
        For Each r In Range("C2", Range("C" & Rows.Count).End(xlUp))
            If .test(r.Value) Then
                Set m = .Execute(r.Value)
                For i = 0 To m.Count - 1
                 c = IIf(m(i).submatches(1) = "", _
                    m(i).submatches(0), m(i).submatches(0) & "/" & m(i).submatches(1))
                r(, 2 + i).Value = c
                Next
            End If
        Next
    End With
    Application.DisplayAlerts = True
End Sub

Display More

Apr 13th 2016

#9

Re: Extract dollar amount from cell

Hi,

I have problem for extracting $ amount and percentage. Because I have used multiple patterns for extract amount!

Code

Sub spliter()
Dim r As Range, I As Long, m As Object
    Application.DisplayAlerts = False
     
        Call SPACER
        Sheets("Riven").Select
        For Each r In Range("C1", Range("C" & Rows.Count).End(xlUp))
         
         With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
        
         
             
          .Pattern = "(\$\d+\d+)|(\$(\d+(\,\d+)?))|(\$\d+,\d+)|(\b\d+\d+\%)|(\b\d+\%)"
            If .test(r.Value) Then
                Set m = .Execute(r.Value)
                For I = 0 To m.Count - 1
                    r(, 2 + I).Value = m(I)
                   Next
             End If
                  
           
           .Pattern = "(\$\d+,\d+)|(\$\d+\d+)"
            If .test(r.Value) Then
                Set m = .Execute(r.Value)
                For I = 0 To m.Count - 1
                    r(, 2 + I).Value = m(I)
                   Next
             End If
                  
          
           .Pattern = "(Emergency Room Services at Hospital Network or Non-Network\-\-)(\$\d+)( Copayment per visit, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
                'ws2.Range("A" & Rows.Count).End(xlUp)(2) = r.Offset(, -2)
                'ws2.Range("B" & Rows.Count).End(xlUp)(2) = r.Offset(, -1)
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                 r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
           
           
          .Pattern = "(Inpatient Facility--)(\$\d+)( Copayment per admission, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
            .Pattern = "(Inpatient Facility--)(\$\d+\,\d+)( Copayment per admission, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
             
             .Pattern = "(Outpatient Surgery Hospital/Alternative Care Facility\-\-)(\$\d+)( Copayment per visit, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
            .Pattern = "(Outpatient Surgery Hospital/Alternative Care Facility\-\-)(\$\d+\,\d+)( Copayment per visit, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
             
              .Pattern = "(Inpatient Facility Mental Health & Substance Abuse\-\-)(\$\d+)( Copayment per admission, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
             
             .Pattern = "(Inpatient Facility Mental Health & Substance Abuse\-\-)(\$\d+\,\d+)( Copayment per admission, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
             
             
              .Pattern = "(Physician Home and Office Services\-\-)(\$\d+)( Copayment per visit, plus an additional )?(\d+%)?"
            
            If .test(r.Value) Then
               
                 Set m = .Execute(r.Value)
                 For I = 0 To m.Count - 1
                  r(, 2 + I).Value = .Execute(r)(I).submatches(1) & IIf(.Execute(r)(I).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(I).submatches(3))
                 Next
             End If
             
             
           End With
       
        Next
    
    Application.DisplayAlerts = True
End Sub

Display More

This code producing wrong result!

I want extract same order which is in cell ! if % comes first then extract!!! Hope You understand! Please find the attachment! FYI

regards,
Dev

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login

Share

This site uses cookies. By continuing to browse this site, you are agreeing to our use of cookies. More Details Close

Your browser has JavaScript disabled. If you would like to use all features of this site, it is mandatory to enable JavaScript.