Removing last two characters having alphabets

[Deepk]

Hi team,

I have list of entries in an excel column, see example below

AB203467A1
SC345745BB
KC983434T
HE98765P1
AS456382

I want to have a macro that convert these numbers to the following and paste in the next column

AB203467 (A1 removed)
SC345745 (BB removed)
KC983434 (T removed)
HE98765 (P1 removed)
AS456382 (nothing removed)

In short, I want to remove

last two characters if a number is followed by alphabet or both characters are alphabets
only last character if it is alphabet
nothing is removed if there is no alphabet in last two characters.

Please help me with this. Thanks in advance.

 

[Takae]

Hope this helps.

Sub test()
    Dim w, strPattern As String, i As Long, LR As Long, buf
    Set w = CreateObject("VBScript.RegExp")
    strPattern = "\D+(\d|\D|$)$"
    With w
        .Pattern = strPattern
        .IgnoreCase = True
        .Global = True
        LR = cells(Rows.count, 1).End(xlUp).Row
        For i = 1 To LR
            Set buf = .Execute(cells(i, 1))
            If buf.count > 0 Then
                cells(i, 2).Value = WorksheetFunction.Substitute(cells(i, 1).Value, buf(0), "")
            Else
                cells(i, 2).Value = cells(i, 1).Value
            End If
        Next
    End With
    Set buf = Nothing
    Set w = Nothing
End Sub

 

[kvsrinivasamurthy]

ARRAY formula in B2

=LEFT(A2,IFERROR(SMALL(IF(ISERROR(0+MID(A2,ROW(INDIRECT(LEN(A2)-4&":"&LEN(A2))),1)),ROW(INDIRECT(LEN(A2)-4&":"&LEN(A2))),""),1)-1,LEN(A2)))

ARRAY formula is used


To enter ARRAY formula
Paste the formula
Press F2
Press Ctrl+Shift+Enter keys together.
formula will be covered with{} brackets by excel.

 

[Peter_SSs]

Since you asked for a macro, assuming the data is in column A starting at row 2, try the following in a copy of your workbook.

Sub RemoveAtEnd()
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    .Offset(, 1).Value = Evaluate(Replace("if(#="""","""",left(#,len(#)-2+if(isnumber(mid(#,len(#)-1,1)+0),1+isnumber(right(#,1)+0),0)))", "#", .Address))
  End With
End Sub

Column B below was produced by the above code, but I have included column C just in case you decide that a formula would suffice.

Excel Workbook
	A	B	C
1
2	AB203467A1	AB203467	AB203467
3	SC345745BB	SC345745	SC345745
4	KC983434T	KC983434	KC983434
5	HE98765P1	HE98765	HE98765
6	AS456382	AS456382	AS456382
Sheet1

 

[Deepk]

Hi Takae,

Thank you for your swift response. However this code is not working.

Request you to look again. Thank you.

Hope this helps.

Sub test()
    Dim w, strPattern As String, i As Long, LR As Long, buf
    Set w = CreateObject("VBScript.RegExp")
    strPattern = "\D+(\d|\D|$)$"
    With w
        .Pattern = strPattern
        .IgnoreCase = True
        .Global = True
        LR = cells(Rows.count, 1).End(xlUp).Row
        For i = 1 To LR
            Set buf = .Execute(cells(i, 1))
            If buf.count > 0 Then
                cells(i, 2).Value = WorksheetFunction.Substitute(cells(i, 1).Value, buf(0), "")
            Else
                cells(i, 2).Value = cells(i, 1).Value
            End If
        Next
    End With
    Set buf = Nothing
    Set w = Nothing
End Sub

 

[Deepk]

Hi Peter,

Thank you for your help. Will it be possible to change the code so that it will provide the output in the same column? Thank you.

 

[Peter_SSs]

Hi Peter,

Thank you for your help. Will it be possible to change the code so that it will provide the output in the same column? Thank you.

Sure, just delete the Offset

Sub RemoveAtEnd()
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    <del>.Offset(, 1)</del>.Value = Evaluate(Replace("if(#="""","""",left(#,len(#)-2+if(isnumber(mid(#,len(#)-1,1)+0),1+isnumber(right(#,1)+0),0)))", "#", .Address))
  End With
End Sub

 

[Deepk]

Sure, just delete the Offset

Sub RemoveAtEnd()
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    <del>.Offset(, 1)</del>.Value = Evaluate(Replace("if(#="""","""",left(#,len(#)-2+if(isnumber(mid(#,len(#)-1,1)+0),1+isnumber(right(#,1)+0),0)))", "#", .Address))
  End With
End Sub

Perfect. Thank you Peter.

 

[Peter_SSs]

Perfect. Thank you Peter.

You are welcome.

 

[Deepk]

Sure, just delete the Offset

Sub RemoveAtEnd()
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    <del>.Offset(, 1)</del>.Value = Evaluate(Replace("if(#="""","""",left(#,len(#)-2+if(isnumber(mid(#,len(#)-1,1)+0),1+isnumber(right(#,1)+0),0)))", "#", .Address))
  End With
End Sub

Dear Peter,

Could you please help! I have modified your code a bit but its showing an error

Sub RemoveAtEnd()
Dim rng As Range


for each rng in Selection
.Value = Evaluate(Replace("if(#="""","""",left(#,len(#)-2+if(isnumber(mid(#,len(#)-1,1)+0),1+isnumber(right(#,1)+0),0)))", "#", .Address))
next rng
MsgBox "Process Completed Successfully."
End Sub