Extract all data values from a cell that begin with j

whitjm4

New Member
Joined
Jan 17, 2018
Messages
5
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.
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,951
paste /or load the extract into a sheet, then run the macro:

Code:
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
 
Last edited:

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,386
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Here's a UDF you can try with an example of its use.
Excel Workbook
AB
1J0210;#7;#J0497;#28;#J0984;#82;#J0692;#68J0210;J0497;J0984;J0692
Sheet1

Code:
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

New Member
Joined
Jan 17, 2018
Messages
5
This works great as a function in the worksheet but how can I use it as a macro in a vba module?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,882
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP
Joined
May 26, 2009
Messages
17,386
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
This works great as a function in the worksheet but how can I use it as a macro in a vba module?
Like this:
Code:
Sub TestExtract()
Dim S As String
S = Range("A1").Value
Range("B1").Value = ExtractJs(S)
End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,672
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Here's a UDF you can try with an example of its use.
Excel Workbook
AB
1J0210;#7;#J0497;#28;#J0984;#82;#J0692;#68J0210;J0497;J0984;J0692
Sheet1

Code:
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...
Code:
[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]
 
Last edited:

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,689
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
I would go with the UDF from Joe4.
If the missing hash is not an oversight, this should work also.
Change references where required.
Code:
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,882
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Sep 5, 2004
Messages
1,689
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,186
Messages
5,594,745
Members
413,929
Latest member
Hypatia

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top