Extracting words based on two initial characters

D

Deepk

Board Regular
Joined
Mar 21, 2018
Messages
105
Office Version
  1. 2016
Platform
  1. Windows
Hi team,

I have some entries in cells of a column. See example below
A
1 AB67436C1 | SR7487OP | KW465875QP | LO68782XE | SR5743257TA

2 LO68782XE | KW465875QP | AB67436C1 | SR465456YA | BV47586TR

3 DZ7645657UO

I want to have a macro that extract the individual entries based on the the first two alphabets. The macro should work in the following manner.

It ask me to enter (in an inputbox) the list of two alphabets, like "SR, LO, BV".
ask me to enter (in second inputbox) the column number in which the extracted data should be pasted. Like "4".
It gives output in the 4th column like below

D
1 SR7487OP | LO68782XE | SR5743257TA

2 LO68782XE | SR465456YA | BV47586TR

3 Not Available

Looking forward in anticipation!

Thank you.
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
Hi. Create a UserForm with 1 textbox for your list of two characters (SR, LO, BV),1 textbox to type in your column number and 1 command button.

Add this code to your command button :

Code: 
Private Sub CommandButton1_Click()
    Dim alpha, strBuffer As String
    Dim col As Double
    Dim refList As Variant
    Dim c As Range
    Dim i As Integer
    
    alpha = TextBox1.Value
    col = CInt(TextBox2.Value)
    
    For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    
        refList = Split(Replace(c.Value, " ", ""), "|")
        
        For Each ref In refList
            
            If InStr(1, alpha, Left(ref, 2)) > 0 Then
                strBuffer = strBuffer & ref & " | "
                i = i + 1
            End If
                        
        Next ref
        
        If i > 0 Then
            c.Offset(0, col - 1).Value = Left(strBuffer, Len(strBuffer) - 3)
        Else
            c.Offset(0, col - 1).Value = "Not Found"
        End If
        
        i = 0
        strBuffer = ""
    
    Next c
    
End Sub
 
Last edited:
Upvote 0
Here is a version that doesn't need a UserForm and just pops up an Inputbox twice :

Code: 
Sub ClearMinus()
    Dim alpha, strBuffer As String
    Dim col As Double
    Dim refList As Variant
    Dim c As Range
    Dim i As Integer
    
    On Error GoTo ErrHandling
    
    alpha = InputBox("Choose a two-character list", "Prompt")
    col = CInt(InputBox("Choose a column number", "Prompt"))
    
    For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    
        refList = Split(Replace(c.Value, " ", ""), "|")
        
        For Each ref In refList
            
            If InStr(1, alpha, Left(ref, 2)) > 0 Then
                strBuffer = strBuffer & ref & " | "
                i = i + 1
            End If
                        
        Next ref
        
        If i > 0 Then
            c.Offset(0, col - 1).Value = Left(strBuffer, Len(strBuffer) - 3)
        Else
            c.Offset(0, col - 1).Value = "Not Found"
        End If
        
        i = 0
        strBuffer = ""
    
    Next c
    
ErrHandling:
    If Err.Number <> 0 Then MsgBox Prompt:="Please verify the data your entered", Title:="Prompt Error"
End Sub
 
Last edited:
Upvote 0
louisH said:
Here is a version that doesn't need a UserForm and just pops up an Inputbox twice :

Code: 
Sub ClearMinus()
    Dim alpha, strBuffer As String
    Dim col As Double
    Dim refList As Variant
    Dim c As Range
    Dim i As Integer
    
    On Error GoTo ErrHandling
    
    alpha = InputBox("Choose a two-character list", "Prompt")
    col = CInt(InputBox("Choose a column number", "Prompt"))
    
    For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    
        refList = Split(Replace(c.Value, " ", ""), "|")
        
        For Each ref In refList
            
            If InStr(1, alpha, Left(ref, 2)) > 0 Then
                strBuffer = strBuffer & ref & " | "
                i = i + 1
            End If
                        
        Next ref
        
        If i > 0 Then
            c.Offset(0, col - 1).Value = Left(strBuffer, Len(strBuffer) - 3)
        Else
            c.Offset(0, col - 1).Value = "Not Found"
        End If
        
        i = 0
        strBuffer = ""
    
    Next c
    
ErrHandling:
    If Err.Number <> 0 Then MsgBox Prompt:="Please verify the data your entered", Title:="Prompt Error"
End Sub
Click to expand...

Hi LouisH,

Could you please check this code is not giving proper result. Thank you.
 
Upvote 0
Deepk said:
Hi LouisH,

Could you please check this code is not giving proper result. Thank you.
Click to expand...

Hi.
The code worked for me with the sample data you gave in your initial post.

What do you mean by "not giving proper result".
Can you please give me more sample data and expected result if the example in your initial post was not representative of your actual worksheet.

What are the entries you gave to the inputbox ?
 
Upvote 0
Here is how I entered the data, and the output of the macro

String of text : AB, BV
Column : 2

A
B
1
AB67436C1 | SR7487OP | KW465875QP | LO68782XE | SR5743257TA
AB67436C1
2
LO68782XE | KW465875QP | AB67436C1 | SR465456YA | BV47586TR
AB67436C1 | BV47586TR
3
DZ7645657UO
Not Found

<tbody>
</tbody>
 
Last edited:
Upvote 0
louisH said:
Here is how I entered the data, and the output of the macro

String of text : AB, BV
Column : 2

AB
1AB67436C1 | SR7487OP | KW465875QP | LO68782XE | SR5743257TAAB67436C1
2LO68782XE | KW465875QP | AB67436C1 | SR465456YA | BV47586TRAB67436C1 | BV47586TR
3DZ7645657UONot Found

<tbody>
</tbody>
Click to expand...

Sorry, its my mistake. I have modified your code a bit. But the code is not pasting the final data in the input column. It is going somewhere else :(. Please see below.

Sub RefineNumber()


Dim alpha, strBuffer As String
Dim col As Double
Dim refList As Variant
Dim c As Range
Dim i As Integer

On Error GoTo ErrHandling

alpha = InputBox("Choose Country Codes", "Prompt")
col = CInt(InputBox("Choose a column number", "Prompt"))

' For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

For Each c In Selection

refList = Split(Replace(c.Value, " ", ""), "|")

For Each ref In refList

If InStr(1, alpha, Left(ref, 2)) > 0 Then
strBuffer = strBuffer & ref & " | "
i = i + 1
End If

Next ref

If i > 0 Then
c.Offset(0, col - 1).Value = Left(strBuffer, Len(strBuffer) - 3)
Else
c.Offset(0, col - 1).Value = "Not Found"
End If

i = 0

strBuffer = ""

Next c

ErrHandling:
If Err.Number <> 0 Then MsgBox Prompt:="Please verify the data your entered", Title:="Prompt Error"

MsgBox "Process Completed Successfully."

End Sub
 
Last edited:
Upvote 0
Ok so i assume the original data is not in column A. I modified it (and tried it), now it should go in the right column.

Code: 
Sub RefineFamily()

 Dim alpha, strBuffer As String
 Dim col As Double
 Dim refList As Variant
 Dim c As Range
 Dim i As Integer
 On Error GoTo ErrHandling
 alpha = InputBox("Choose Country Codes", "Prompt")
 col = CDbl(InputBox("Choose a column number", "Prompt"))
 ' For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
     For Each c In Selection
    
         refList = Split(Replace(c.Value, " ", ""), "|")
        
         For Each ref In refList
        
         If InStr(1, alpha, Left(ref, 2)) > 0 Then
         strBuffer = strBuffer & ref & " | "
         i = i + 1
         End If
        
         Next ref
        
         If i > 0 Then
            Cells(c.Row, col).Value = Left(strBuffer, Len(strBuffer) - 3)
         Else
            Cells(c.Row, col).Value = "Not Found"
         End If
        
         i = 0
        
         strBuffer = ""
        
     Next c
ErrHandling:
 If Err.Number <> 0 Then
MsgBox Prompt:="Please verify the data your entered", Title:="Prompt Error"
Else
 MsgBox "Process Completed Successfully."
End If
 End Sub
 
Last edited:
Upvote 0
louisH said:
Ok so i assume the original data is not in column A. I modified it (and tried it), now it should go in the right column.

Code: 
Sub RefineFamily()

 Dim alpha, strBuffer As String
 Dim col As Double
 Dim refList As Variant
 Dim c As Range
 Dim i As Integer
 On Error GoTo ErrHandling
 alpha = InputBox("Choose Country Codes", "Prompt")
 col = CDbl(InputBox("Choose a column number", "Prompt"))
 ' For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
     For Each c In Selection
    
         refList = Split(Replace(c.Value, " ", ""), "|")
        
         For Each ref In refList
        
         If InStr(1, alpha, Left(ref, 2)) > 0 Then
         strBuffer = strBuffer & ref & " | "
         i = i + 1
         End If
        
         Next ref
        
         If i > 0 Then
            Cells(c.Row, col).Value = Left(strBuffer, Len(strBuffer) - 3)
         Else
            Cells(c.Row, col).Value = "Not Found"
         End If
        
         i = 0
        
         strBuffer = ""
        
     Next c
ErrHandling:
 If Err.Number <> 0 Then
MsgBox Prompt:="Please verify the data your entered", Title:="Prompt Error"
Else
 MsgBox "Process Completed Successfully."
End If
 End Sub
Click to expand...

hi louisH,

Hope you are doing good.

I want a slight modification in this code. I want to feed a list of two initial characters like

MyData = (AB, BV, CA.... and so on)

If someone enters two initial characters (in the inputbox) other than the characters provided in the list, an error msgbox = "Check your input!" will appear and it exit the macro
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
extract values based on next two columns
Replies
7
Views
229
Fluff
Fluff
C
  • Question
Use Row Data to Create New Sheet from Template and Reference Data
Replies
0
Views
392
ChrisMas92
C
M
  • Solved
trying to select two columns
Replies
4
Views
355
Alex Blakenburg
A
M
  • Solved
Stop a search/filter formula based on two columns from duplicating a row that has a hit in both columns
Replies
1
Views
663
Marzatron
M
J
  • Locked
  • Question
Excel Exercise for School Based Job
2 3
Replies
26
Views
5K
MARK858
MARK858

Forum statistics

Threads
1,215,461
Messages
6,124,955
Members
449,200
Latest member
indiansth

Share this page

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
Back
Top