VBA to extract values starting with specific character

sncb

Board Regular
Joined
Mar 17, 2011
Messages
123
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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:
1622830344926.png


Output:
1622830232979.png
 

Attachments

  • 1622829996555.png
    1622829996555.png
    15.1 KB · Views: 6

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,600
Office Version
  1. 2010
Platform
  1. Windows
Optimized pattern for previous code if more than one letter after the number : "B\d+\w*" …​
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

sncb

Board Regular
Joined
Mar 17, 2011
Messages
123
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
The RegExp way :​
VBA Code:
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

Board Regular
Joined
Mar 17, 2011
Messages
123
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Bad testing on my part.:mad: Try this version instead...
VBA Code:
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 - WAB757Boeing (Green);B707 | Toulouse 2;B747| Airbus 1;B787a | Learjet 1;B717 | Boeing 1;B737 | Boeing 1;WAB737
B707B707
B707B747
B717B787a
B727B717
B737cB737
B747B737
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 - WAB757Boeing (Green);B707 | Toulouse 2;B747| Airbus 1;B787a | Learjet 1;B717 | Boeing 1;B737 | Boeing 1;WAB737
WAB707B707
B707B747
B717B787a
B727B717
B737cB737
B747WAB737
B757
WAB757


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

Forum statistics

Threads
1,144,342
Messages
5,723,818
Members
422,518
Latest member
quack_quack

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