Remove Everything When Numbers End To Adjacent Column

[Dazzawm]

I have numbers as below. When the numbers end I want everything removed to the adjacent column. I cant use text to columns as there are varying lengths etc. So a code or formula please.

P.S Some may not have letters etc after numbers for example WA2345

Before

Excel 2010

Row\Col	AE​
15998​	WA11711N
15999​	WA20293R
16000​	WA22721N-WSD
16001​	WA20563-OS
16002​	WA20700N
16003​	WA20562-OS

Sheet: Sheet1

After

Excel 2010

Row\Col	AE​	AF​
15997​	WA20325	N
15998​	WA11711	N
15999​	WA20293	R
16000​	WA22721	N-WSD
16001​	WA20563	-OS
16002​	WA20700	N
16003​	WA20562	-OS

Sheet: Sheet1

 

[mohadin]

Sorry does not do anything.

It works now your data in A1 as the other presented
then

Sub tester()
 Dim sm As Object, a, lr, i, j, m, sm1, sm2
 lr = Cells(Rows.Count, 1).End(xlUp).Row
 a = Application.Transpose(Cells(1, 1).Resize(lr))
 ReDim b(1 To lr, 1 To 2)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(.+?\d+)|(.?|w)+"
        For j = 1 To lr
        Set m = .Execute(a(j))
        
            Set sm1 = m(0)
            Set sm2 = m(1)
                b(j, 1) = sm1
                b(j, 2) = sm2
       
        Next
    End With
    [b1].Resize(UBound(b, 1), 2) = b
End Sub

The result in B1:C1.....B6:C6

Check

 

[Dazzawm]

Actually I need it for columns AE and AF please.

 

[mohadin]

Thanks
change

[a1].Resize(UBound(b, 1), 2) = b

to

[ae[B]15998[/B]].Resize(UBound(b, 1), 2) = b

 

[Dazzawm]

This doesn't appear to work either. It removes all my data in column AE and replaces it with numbers like 1.7, 0.4, 1.6 etc..? These happen to be in column A?!

 

[Dazzawm]

Just to recap my data starts in AE2 and would like the ends removed to column AF.

 

[mohadin]

Hi just to make sure I well understand

Your data are in AE2 down to the end of column AE Ok?
Then you will need to replace your data with the first part of it (only) and for get the second part?
or you need the second part to be placed in the next column (AF)?

 

[Peter_SSs]

Are you over-complicating

EVERY example provided by you could be returned with

=LEFT(A2,7)

@Dazzawm
What is the answer/comment/alternative sample data in response to this question?

 

[mohadin]

Hi just to make sure I well understand

Your data are in AE2 down to the end of column AE Ok?
Then you will need to replace your data with the first part of it (only) and for get the second part?
or you need the second part to be placed in the next column (AF)?

Any way try this demo and let me know how It goes

Sub Demo()
    Dim sm As Object, a, lr, c, i, j, m, sm1, sm2
    Dim x As Range
    Set x = Application.InputBox("Type first range your DATA start from", , , , , , , 8)
    lr = Cells(Rows.Count, x.Column).End(xlUp).Row - 1
    a = Application.Transpose(x.Resize(lr))
    ReDim b(1 To lr, 1 To 2)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(.+?\d+)|(.?|w)+"
        For j = 1 To UBound(a)
            If a(j) <> "" Then
                Set m = .Execute(a(j))
                Set sm1 = m(0)
                Set sm2 = m(1)
                b(j, 1) = sm1
                b(j, 2) = sm2
            End If
        Next
    End With
    Set x = Application.InputBox("Where to place the resule", , , , , , , 8)
    c = MsgBox("Do you want the second part to the next column", vbQuestion + vbYesNo + vbDefaultButton2, "Desision")
    If c = vbYes Then
        x = 2
    Else
        x = 1
    End If
    [x].Resize(UBound(b, 1), x) = b
End Sub

 

[mohadin]

verII

Sub Demo()
    Dim sm As Object, a, lr, c, i, j, m
    Dim x As Range
    Set x = Application.InputBox("Type first range your DATA start from", , , , , , , 8)
    lr = Cells(Rows.Count, x.Column).End(xlUp).Row - 1
    a = Application.Transpose(x.Resize(lr))
    ReDim b(1 To lr, 1 To 2)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(.+?\d+)|(.?|w)+"
        For j = 1 To UBound(a)
            If a(j) <> "" Then
                Set m = .Execute(a(j))
                b(j, 1) = m(0)
                b(j, 2) = m(1)
            End If
        Next
    End With
    Set x = Application.InputBox("Where to place the resule", , , , , , , 8)
    c = MsgBox("Do you want the second part to the next column", vbQuestion + vbYesNo + vbDefaultButton2, "Desision")
    If c = vbYes Then
        x = 2
    Else
        x = 1
    End If
    [x].Resize(UBound(b, 1), x) = b
End Sub

 

[Yongle]

@Dazzawm

Is this the pattern to the first segment of string ?

( ONE or more ) ALPHA followed (ONE or more) NUMERIC

Here is UDF that can be used in the worksheet

Function [COLOR=#008000]Get_Item[/COLOR](ByVal Text As String) As String
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[a-zA-Z]+[0-9]+"
        If .Test(Text) Then Get_Item = .Execute(Text)(0)
    End With
End Function

Or can be called in a macro like this (results in columns F & G below)

Sub CallFunction()
    Dim cel As Range, x As String
    For Each cel In ActiveSheet.Range("A2:A8")
        x = [COLOR=#008000]Get_Item[/COLOR](cel)
        cel.Offset(, 5) = x
        cel.Offset(, 6) = Replace(cel, x, "")
    Next cel
End Sub

Excel 2016 (Windows) 32 bit

	A​	B​	C​	D​	E​	F​	G​
1​	Oiginal	Result1 (UDF)	Result2	B2 copied down	C2 copied down	Result1 from VBA	Result2 from VBA
2​	WA11711N	WA11711	N	=Get_Item(A2)	=SUBSTITUTE(A2,B2,"")	WA11711	N
3​	WA20293R	WA20293	R			WA20293	R
4​	WA22721N-WSD	WA22721	N-WSD			WA22721	N-WSD
5​	WA20563-OS	WA20563	-OS			WA20563	-OS
6​	WA20700N	WA20700	N			WA20700	N
7​	WA20562-OS	WA20562	-OS			WA20562	-OS
8​	WA13381N-6G	WA13381	N-6G			WA13381	N-6G

Sheet: Sheet4