Remove values from string based on criteria

[JP_Romano]

Good day all - struggling a bit with how to do this, and am hoping somebody here already has it worked out somewhere and would be willing to share it.

I have a series of strings that look, roughly like the sting below. There can be anywhere from 1 to 1000 elements. The string is in this order:
CODE|SCORE|DESCRIPTION

ASIA|(0) (100)|Asia, Pacific Rim|BIZNEWS|(100) (100)|Bus, Eco, Govt News|BUSINESS|(100) (100)|Business News|CECO|(100) (100)|Country Economies|EURX|(70) (100)|European Exchange Vals|

What I need to do, is remove all elements when the score is NOT (100)(100). So for the above, I should be left with the string below (the first and last set of element have been removed as they do not meet the criteria:

BIZNEWS|(100) (100)|Bus, Eco, Govt News|BUSINESS|(100) (100)|Business News|CECO|(100) (100)|Country Economies

I hope this is sufficient info - if not, and you're willing to lend a hand, please let me know what else I can provide.

Thank you!
JP

 

[JLGWhiz]

Using VBA and assuming your data is in column A beginning in cell A1. Uses sheet2 for display.

Sub extract()
Dim sh As Worksheet, c As Range, spl As Variant, i As Long
Set sh = Sheets("Sheet1") 'edit sheet name
    For Each c In sh.Range("A1", sh.Cells(Rows.Count, 1).End(xlUp))
        spl = Split(c.Value, "|")
        For i = LBound(spl) To UBound(spl)
            If InStr(spl(i), "(100) (100)") > 0 Then
                txt = txt & spl(i - 1) & spl(i) & spl(i + 1) & "|"
            End If
        Next
        Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2) = txt
    Next
End Sub

 

[Max1616]

Hello!

This is the best I could come up with:

Sub JP_Romano()

Dim lrow As Long
Dim lclm As Long
Dim maxlclm As Long
Dim i As Long
Dim j As Long
Dim counter As Integer

lrow = Cells(Rows.Count, 1).End(xlUp).Row
counter = 3
Range("A:A").TextToColumns Destination:=Range("A:A"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, OtherChar:="|"
Columns(1).Insert
maxlclm = 1

For i = 1 To lrow
    lclm = Cells(i, Columns.Count).End(xlToLeft).Column
    If lclm > maxlclm Then maxlclm = lclm
    For j = 3 To lclm
        If j = counter Then
            If Trim(Cells(i, j)) = "(100) (100)" Then Cells(i, 1) = Cells(i, 1) & Cells(i, j - 1) & "|" & Cells(i, j) & "|" & Cells(i, j + 1) & "|"
            counter = counter + 3
        End If
    Next j
    Cells(i, 1) = Left(Cells(i, 1), Len(Cells(i, 1)) - 1)
    counter = 3
Next i
Range(Columns(2), Columns(maxlclm)).Delete
End Sub

It requires no data to be in the columns right of your data. It also assumes your list of strings are in column A.

It seems to be working great in my test environment. Let me know how it does!

Sincerely,
Max

 

[JP_Romano]

Thank you both so much - these are both brilliant.... can't wait to try them out in the morning (sadly, I forgot to bring home the biometric device that lets me log in remotely).

Really, really appreciate your time and help.