split,Copy paste cell Based on Criteria

keerthi deva · Mar 29th 2016

Hi All,

Inopportunely I don't know much about the VBA language so I'll appreciate it if you could help me on this. I want macro to split dollar and percentage values based on prefix string and copy result and paste based on next sheet Headers and ID. I have attached sample workbook.
Thank you in advance.

Regards,
Dev

**StephenR** · Mar 30th 2016

Re: split,Copy paste cell Based on Criteria

It would be helpful to have a few more examples in your file to get an idea of the variability. Otherwise somebody may post code which works on your sample but doesn't work on your actual file if there are differences.

keerthi deva · Mar 31st 2016

Re: split,Copy paste cell Based on Criteria

First of all Thank you for your time!

I have data in same format which is in file but each cell have more no. of sentences. But "apple" and "orange" words are comes one time in each cell. :read:

Also apple values are end with before orange and spaces.

For example, common thing is highlighted below,

we received Apple profit--$150 and orange profit--- $52 and 20%

I want split after apple before orange if any $ and % numbers are there combine and paste target cell. same for Orange data also.

Hope u have any idea on over all!

Regards,
Dev

**StephenR** · Mar 31st 2016

Re: split,Copy paste cell Based on Criteria

This seems to work for your sample file

Code

Sub x()


Dim r As Range, ws1 As Worksheet, ws2 As Worksheet


Set ws1 = Sheets("Input")
Set ws2 = Sheets("Output sheet")


For Each r In ws1.Range("B2", ws1.Range("B" & Rows.Count).End(xlUp))
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        .Pattern = "(apple profit\-\-)(\$\d+)( and )?(\d+%)?"
        If .Test(r) Then
            ws2.Range("A" & Rows.Count).End(xlUp)(2) = r.Offset(, -1)
            ws2.Range("B" & Rows.Count).End(xlUp)(2) = .Execute(r)(0).submatches(1) & IIf(.Execute(r)(0).submatches(3) = vbNullString, "", "/" & _
                                                       .Execute(r)(0).submatches(3))
        End If
        .Pattern = "(orange profit\-\-\- )(\$\d+)( and )?(\d+%)?"
        If .Test(r) Then
            ws2.Range("C" & Rows.Count).End(xlUp)(2) = .Execute(r)(0).submatches(1) & IIf(.Execute(r)(0).submatches(3) = vbNullString, "", "/" & _
                                                       .Execute(r)(0).submatches(3))
        End If
        .Pattern = "(banana profit\-\-\- )(\$\d+)( and )?(\d+%)?"
        If .Test(r) Then
            ws2.Range("D" & Rows.Count).End(xlUp)(2) = .Execute(r)(0).submatches(1) & IIf(.Execute(r)(0).submatches(3) = vbNullString, "", "/" & _
                                                       .Execute(r)(0).submatches(3))
        End If
    End With
Next r


End Sub

Display More

keerthi deva · Mar 31st 2016

Re: split,Copy paste cell Based on Criteria

Awesome!!!:cool: works perfectly!!! Thank you very much!:thanx:

**StephenR** · Mar 31st 2016

Re: split,Copy paste cell Based on Criteria

Glad to hear it.

keerthi deva · Mar 31st 2016

Re: split,Copy paste cell Based on Criteria

Could you please Explain this lines? I am not able to understand!

Code

ws2.Range("B" & Rows.Count).End(xlUp)(2) = .Execute(r)(0).submatches(1) & IIf(.Execute(r)(0).submatches(3) = vbNullString, "", "/" & _ 
                .Execute(r)(0).submatches(3))

keerthi deva · Mar 31st 2016

Re: split,Copy paste cell Based on Criteria

Based on your coding I can change some lines based on my requirements. But result comes only first pattern its not moving to next if condition! I don't know why? Could you say where I wrong?

please find my below code... FYI

Code

Sub spliter()
'Call Command
Dim r As Range, i As Long, m As Object
    Application.DisplayAlerts = False
        '.Pattern = "\$\d+\d+"
        '.Pattern = "\$(\d+(\,\d+)?)"
         
       
        For Each r In Range("C1", Range("C" & Rows.Count).End(xlUp))
         
         With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
        .Pattern = "(apple\-\-)(\$\d+)( and)?(\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)(0).submatches(1) & IIf(.Execute(r)(0).submatches(3) = vbNullString, "", "/" & _
                .Execute(r)(0).submatches(3))
                 Next
        End if
        .Pattern = "(\$\d+\d+)|(\$(\d+(\,\d+)?))|(\b\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
           
            
           End With
       
        Next
    
    Application.DisplayAlerts = True
End Sub

Display More

split,Copy paste cell Based on Criteria

Participate now!

Share

Users Viewing This Thread