Remove Everything When Numbers End To Adjacent Column

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,786
Office Version
  1. 365
Platform
  1. Windows
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
[Table="width:, class:head"][tr=bgcolor:#888888][th]Row\Col[/th][th]
AE
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
15998
[/td][td=bgcolor:#99CCFF]WA11711N[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
15999
[/td][td=bgcolor:#99CCFF]WA20293R[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16000
[/td][td=bgcolor:#99CCFF]WA22721N-WSD[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16001
[/td][td=bgcolor:#99CCFF]WA20563-OS[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16002
[/td][td=bgcolor:#99CCFF]WA20700N[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16003
[/td][td=bgcolor:#99CCFF]WA20562-OS[/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]

After

Excel 2010
[Table="width:, class:head"][tr=bgcolor:#888888][th]Row\Col[/th][th]
AE
[/th][th]
AF
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
15997
[/td][td=bgcolor:#99CCFF]WA20325[/td][td=bgcolor:#99CCFF]N[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
15998
[/td][td=bgcolor:#99CCFF]WA11711[/td][td=bgcolor:#99CCFF]N[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
15999
[/td][td=bgcolor:#99CCFF]WA20293[/td][td=bgcolor:#99CCFF]R[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16000
[/td][td=bgcolor:#99CCFF]WA22721[/td][td=bgcolor:#99CCFF]N-WSD[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16001
[/td][td=bgcolor:#99CCFF]WA20563[/td][td=bgcolor:#99CCFF]-OS[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16002
[/td][td=bgcolor:#99CCFF]WA20700[/td][td=bgcolor:#99CCFF]N[/td][/tr]


[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
16003
[/td][td=bgcolor:#99CCFF]WA20562[/td][td=bgcolor:#99CCFF]-OS[/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: Sheet1[/td][/tr][/table]
 
Sorry does not do anything.

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

Code:
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
 
Last edited:
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Actually I need it for columns AE and AF please.
 
Upvote 0
Thanks :)
change
Code:
[a1].Resize(UBound(b, 1), 2) = b
to
Code:
[ae[B]15998[/B]].Resize(UBound(b, 1), 2) = b
 
Last edited:
Upvote 0
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?!
 
Last edited:
Upvote 0
Just to recap my data starts in AE2 and would like the ends removed to column AF.
 
Upvote 0
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)?
 
Upvote 0
Are you over-complicating :confused: :confused:

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?
 
Last edited:
Upvote 0
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
Code:
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
 
Upvote 0
verII
Code:
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
 
Upvote 0
@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
Code:
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)
Code:
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
[Table="width:, class:head"][tr=bgcolor:#E0E0F0][th] [/th][th]
A
[/th][th]
B
[/th][th]
C
[/th][th]
D
[/th][th]
E
[/th][th]
F
[/th][th]
G
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
1
[/td][td]Oiginal[/td][td]Result1
(UDF)
[/td][td]Result2[/td][td] B2 copied down[/td][td] C2 copied down[/td][td]Result1
from VBA
[/td][td]Result2
from VBA
[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
2
[/td][td]WA11711N[/td][td]WA11711[/td][td]N[/td][td] =Get_Item(A2)[/td][td] =SUBSTITUTE(A2,B2,"")[/td][td]WA11711[/td][td]N[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
3
[/td][td]WA20293R[/td][td]WA20293[/td][td]R[/td][td][/td][td][/td][td]WA20293[/td][td]R[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
4
[/td][td]WA22721N-WSD[/td][td]WA22721[/td][td]N-WSD[/td][td][/td][td][/td][td]WA22721[/td][td]N-WSD[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
5
[/td][td]WA20563-OS[/td][td]WA20563[/td][td]-OS[/td][td][/td][td][/td][td]WA20563[/td][td]-OS[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
6
[/td][td]WA20700N[/td][td]WA20700[/td][td]N[/td][td][/td][td][/td][td]WA20700[/td][td]N[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
7
[/td][td]WA20562-OS[/td][td]WA20562[/td][td]-OS[/td][td][/td][td][/td][td]WA20562[/td][td]-OS[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#E0E0F0]
8
[/td][td]WA13381N-6G[/td][td]WA13381[/td][td]N-6G[/td][td][/td][td][/td][td]WA13381[/td][td]N-6G[/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: Sheet4[/td][/tr][/table]
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

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