Search List of my codes

Hi

In one cell I have the following text:

H12345 West Atlantic (GMDSS Metarea IV) 0430z 1030z 1630z 2230z
H123456 Tropical Atl. 0415z 1015z 1615z 2215z
Tips H11111 East Pacific (GMDSS Metarea XII) 0545z 1145z 1745z 2345z
H022220 NE Pacific 0430z 1030z 1630z 2230z
Hi Lo not H033333 N. Mid-Pacific 0445z 1045z 1645z
H44444 Mexico highseas 0400z 1000z 1600z 2200z
New H50500 S. Mid-Pacific 0515z 1115z 1715z 2315z
H012345 Peru Highseas (GMDSS Metarea XVI) 0515z

How to filter the following items: (search string = 1 letter + 5/6 numbers)

H12345
H123456
H11111
H022220
H033333
H44444
H50500
H012345

I am looking for suggestions

Are all 8 lines in a single cell or is that 8 rows of data?

If 8 rows, the following UDF will do that:

Code:

---

Function GetHCode(r As String) As String
With CreateObject("vbscript.regexp")
    .Pattern = "H[0-9]{5,6}"
    If .test(r) Then GetHCode = .Execute(r)(0)
End With
End Function

---

Hi,

https://sites.google.com/site/e90e50/vbscript/regexp
RegExp great the first entry is correct!

Unfortunately I can not remove the following entries in the text
I may replace the first string found with "" to search again

You have to find all the results in the cell

Code:

---

Sub GetAllHCodes()
Dim m As Object, s As String, a, n As Long
s = Range("A1")
With CreateObject("vbscript.regexp")
    .Pattern = "H[0-9]{5,6}"
    .Global = True
    If .test(s) Then
        Set m = .Execute(s)
        For Each a In m
            n = n + 1
            Cells(n, 2) = a
        Next
    End If
End With
End Sub

---

Hi

Very well
thank you very much

Quote:

---

Originally Posted by Scott Huish

Code:

---

Sub GetAllHCodes()
Dim m As Object, s As String, a, n As Long
s = Range("A1")
With CreateObject("vbscript.regexp")
    .Pattern = "H[0-9]{5,6}"
    .Global = True
    If .test(s) Then
        Set m = .Execute(s)
        For Each a In m
            n = n + 1
            Cells(n, 2) = a
        Next
    End If
End With
End Sub

---

---

For those who might be interested, you can produce the same results as the above code without using RegExp...

Code:

---

Sub GetAllHCodes()
  Dim X As Long, HCodes As String, H() As String
  H = Split(Range("A1").Value, "H")
  For X = 1 To UBound(H)
    If Not Split(H(X))(0) Like "*[!0-9]*" And InStr(H(X), " ") > 4 Then HCodes = HCodes & " H" & Split(H(X))(0)
  Next
  H = Split(Trim(HCodes))
  Range("B1:B" & UBound(H) + 1) = Application.Transpose(H)
End Sub

---