VBA to extract values starting with specific character

[sncb]

Hi all,

I paste two cells of data into A1 and B1 with different formats and spacing like below and I need to extract only those values that start with a capital 'B' and paste them below the first row in separate rows. What needs to be extracted always start with a 'B' and need to be always whole alphanumeric values like B747 or B737c.

Right now Im doing this manually, value by value and its getting very tedious. I tried with text to columns but each time the format is different and separators are different too so always end up doing it manually. Any help with VBA is really appreciated. Thank you.

Input:

Output:

 

[Marc L]

​

Optimized pattern for previous code if more than one letter after the number : "B\d+\w*" …​

 

[sncb]

The RegExp way :​

Sub Demo2()
            Dim Rg As Range, R&, S$()
    With CreateObject("VBScript.RegExp")
           .Global = True
           .Pattern = "B\d+\w"
        For Each Rg In [A1:B1]
            With .Execute(Rg.Text)
                If .Count Then
                    ReDim S(1 To .Count, 0)
                    For R = 1 To .Count:  S(R, 0) = .Item(R - 1).Value:  Next
                    Rg(2).Resize(.Count).Value2 = S
                End If
            End With
        Next
    End With
End Sub

Hi Marc,

Completely missed out on seeing this post. Yes your solution is working great as well. Big thanks to you too. ?

 

[sncb]

Bad testing on my part. Try this version instead...

Sub Bcodes()
  Dim R As Long, X As Long, Z As Long, Cell As Range, Arr As Variant
  For Each Cell In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
    R = 0
    Arr = Split(Replace(Replace(Cell.Value & "@", vbLf, " "), "B", ";B"), ";B")
    For X = 0 To UBound(Arr)
      If Arr(X) Like "#*" Then
        For Z = 1 To Len(Arr(X))
          If Mid(Arr(X), Z, 1) Like "[!0-9A-Za-z]" Then Arr(X) = Left(Arr(X), Z - 1)
        Next
        R = R + 1
        Cell.Offset(R).Value = "B" & Split(Arr(X))(0)
      End If
    Next
  Next
End Sub

Hi Rick,

Hope's all is good and Thanks for your help as always.

Apologies to come back to you for this but as you may remember, I had to extract B codes from cells A1 and B1 and your code works great. The only thing now I have is that along with the existing data, I also sometimes have codes that start with a 'WA..', so data like the first and last example in Col A and last example in Col B (along with the existing data that start with a B). So this is what the current code does....

NarrowBody - 4 - WAB707 NarrowBody - 4 - B707 NarrowBody - 2 - B717 NarrowBody - 1 - B727 MediumBody - 1 - B737c LargeBody - 1 - B747 LargeBody - 3 - B757 LargeBody - 3 - WAB757	Boeing (Green);B707 | Toulouse 2;B747| Airbus 1;B787a | Learjet 1;B717 | Boeing 1;B737 | Boeing 1;WAB737
B707	B707
B707	B747
B717	B787a
B727	B717
B737c	B737
B747	B737
B757
B757

..and this is what the need to look like:

NarrowBody - 4 - WAB707 NarrowBody - 4 - B707 NarrowBody - 2 - B717 NarrowBody - 1 - B727 MediumBody - 1 - B737c LargeBody - 1 - B747 LargeBody - 3 - B757 LargeBody - 3 - WAB757	Boeing (Green);B707 | Toulouse 2;B747| Airbus 1;B787a | Learjet 1;B717 | Boeing 1;B737 | Boeing 1;WAB737
WAB707	B707
B707	B747
B717	B787a
B727	B717
B737c	B737
B747	WAB737
B757
WAB757

Thanks again if it's possible for you, otherwise its ok.