Macro to extract specific desciptions

[howard]

I have decriptions in Col B on sheet1. I would like a macro to do the following

1) Extract descriptions that contain the following text to sheet2 (including Cols A:B)

sale, sales, fact assist , discount, DIC & rebates, F & I (for eg sale pine desk, fact assist pine desk, discount retail desk, F & I sales)

2) Extract descriptions that contain the following text to sheet3 (including Cols A:B)

COS, O/allowance (for eg COS pine desk, O/allowance,

Your assistance in this regard is most appreciated

 

[howard]

I have also posted on Website below

Macro to extract specific desciptions | Windows Secrets Lounge

 

[apo]

Hi..

This should do it..

Option Compare Text
Private Sub CommandButton1_Click()
Dim r As Range
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Pattern = "\b(sale|sales|fact assist|discount|DIC|rebates|F & I)|COS|O/allowance\b"
        For Each r In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))
        
        If .test(r.Value) = True And InStr(1, r.Value, "COS", 0) Or .test(r.Value) = True And InStr(1, r.Value, "O/Allowance", 0) Then
        r.Offset(, -1).Resize(1, 2).Copy Destination:=Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        Else
        If .test(r.Value) Then r.Offset(, -1).Resize(1, 2).Copy Destination:=Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        End If
        
        Next r
    End With
End Sub

 

[howard]

Hi APO

Thanks for help, much appreciated. If I need to add addtional items to be extracted to sheet 3 do I add to these lines of code? If so where do I add for eg H/Back

.Pattern = "\b(sale|sales|fact assist|discount|DIC|rebates|F & I)|COS|O/allowance\b"
For Each r In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))

If .test(r.Value) = True And InStr(1, r.Value, "COS", 0) Or .test(r.Value) = True And InStr(1, r.Value, "O/Allowance", 0) Then


Regards

Howard

 

[apo]

Hi..

[COLOR=#333333].Pattern = "\b(sale|sales|fact assist|discount|DIC|rebates|F & I|COS|O/allowance|[/COLOR][COLOR=#574123]H/Back)[/COLOR][COLOR=#333333]\b"[/COLOR]
[COLOR=#333333]For Each r In Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))[/COLOR]

[COLOR=#333333]If .test(r.Value) = True And InStr(1, r.Value, "COS", 0) Or .test(r.Value) = True And InStr(1, r.Value, "O/Allowance", 0) [/COLOR][COLOR=#333333]Or .test(r.Value) = True And InStr(1, r.Value, "[/COLOR][COLOR=#574123]H/Back[/COLOR][COLOR=#333333]", 0) [/COLOR][COLOR=#333333]Then[/COLOR]

 

[howard]

Hi APO

Thanks for the help, much appreciated

Howard