Extract all data values from a cell that begin with j

[whitjm4]

I have a data extract where the cell value is

J0210;#7;#J0497;#28;#J0984;#82;#J0692;#68

I only want the values that start with the 'J'. The field value may be multiple lengths but the J values are always 5 characters with a semi-colon.
The result should be J0210;J0497;J0984;J0692.
I think this can be done with a VBA loop but I don't know the syntax.

 

[ranman256]

paste /or load the extract into a sheet, then run the macro:

Public Sub ParseJtxt()
Dim shtSrc As Worksheet, shtTarg As Worksheet
Dim vWord, vLine
Dim i As Integer, k As Integer


Set shtSrc = ActiveSheet
Sheets.Add
Set shtTarg = ActiveSheet
shtSrc.Activate


Range("A1").Select
While ActiveCell.Value <> ""
   vLine = ActiveCell.Value
   i = InStr(vLine, "J")
   While i > 0
       If Left(vLine, 1) <> "J" Then
            i = InStr(vLine, "J")
            vLine = Mid(vLine, i)                    'new line
       End If
       
       k = InStr(vLine, ";")
       If k = 0 Then
         vWord = vLine
       Else
         vWord = Left(vLine, k - 1)
         'vWord = Mid(vLine, i, k - 1)
         vLine = Mid(vLine, k + 1)  'new line
       End If
       
       shtTarg.Activate
        ActiveCell.Value = vWord
        ActiveCell.Offset(1, 0).Select   'next row
       shtSrc.Activate
   
       i = InStr(vLine, "J")
   Wend
    
   ActiveCell.Offset(1, 0).Select    'next row
Wend
Set shtSrc = nothing
Set shtTarg = nothing
 End Sub

 

[JoeMo]

Here's a UDF you can try with an example of its use.

Excel Workbook
	A	B
1	J0210;#7;#J0497;#28;#J0984;#82;#J0692;#68	J0210;J0497;J0984;J0692
Sheet1

Function ExtractJs(S As String) As String
Dim Parts As Variant, X As Variant
If InStr(1, S, "J", vbTextCompare) = 0 Or InStr(1, S, ";") = 0 Then
    ExtractJs = ""
    Exit Function
End If
Parts = Split(S, "#")
For i = LBound(Parts) To UBound(Parts)
    If Parts(i) Like "J####;" Then
        X = X & Parts(i)
    End If
Next i
ExtractJs = Left(X, Len(X) - 1)
End Function

 

[whitjm4]

This works great as a function in the worksheet but how can I use it as a macro in a vba module?

 

[Joe4]

UDFs can be used as function in BOTH the spreadsheets and in VBA, just like you would for any other function native to Excel or VBA.
Since it is the same UDF whether you use it directly on the sheet or VBA, the arguments and structure are exactly the same.

 

[JoeMo]

This works great as a function in the worksheet but how can I use it as a macro in a vba module?

Like this:

Sub TestExtract()
Dim S As String
S = Range("A1").Value
Range("B1").Value = ExtractJs(S)
End Sub

 

[Rick Rothstein]

Here's a UDF you can try with an example of its use.

Excel Workbook
	A	B
1	J0210;#7;#J0497;#28;#J0984;#82;#J0692;#68	J0210;J0497;J0984;J0692
Sheet1

Function ExtractJs(S As String) As String
Dim Parts As Variant, X As Variant
If InStr(1, S, "J", vbTextCompare) = 0 Or InStr(1, S, ";") = 0 Then
    ExtractJs = ""
    Exit Function
End If
Parts = Split(S, "#")
For i = LBound(Parts) To UBound(Parts)
    If Parts(i) Like "J####;" Then
        X = X & Parts(i)
    End If
Next i
ExtractJs = Left(X, Len(X) - 1)
End Function

Assuming any field that has the letter "j" in it will always be followed by 4 digits, here is a one-liner function that returns the same results as your function...

[table="width: 500"]
[tr]
	[td]Function ExtractJs(S As String) As String
  ExtractJs = Replace(Join(Filter(Split(S, ";"), "j", True, vbTextCompare), ";"), "#", "")
End Function[/td]
[/tr]
[/table]

 

[jolivanes]

I would go with the UDF from Joe4.
If the missing hash is not an oversight, this should work also.
Change references where required.

Sub whitjm4()
Dim c As Range, i As Long, a
Application.ScreenUpdating = False
    For Each c In Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
        If Left(Trim(c.Value), 1) <> "#" Then
            c.Value = "#" & Trim(c.Value)
                Else
            c.Value = Trim(c.Value)
        End If
            a = Split(c.Value, ";")
        For i = LBound(a) To UBound(a)
            If Mid(a(i), 2, 1) = "J" Then c.Offset(, 1).Value = c.Offset(, 1).Value & a(i) & ";"
        Next i
    c.Offset(, 1).Value = Left(c.Offset(, 1).Value, Len(c.Offset(, 1).Value) - 1)
    Next c
Application.ScreenUpdating = True

End Sub

 

[Joe4]

I would go with the UDF from Joe4.

I think you mean "JoeMo".
I actually didn't create any UDFs in this thread, just explained how to use them!

 

[jolivanes]

Hi Joe*
How about "Joe somebody"?
Thanks for letting me know though.
Have a good evening.
Apologies to JoeMo for giving someone else credit for his UDF