Remove Everything When Numbers End To Adjacent Column

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
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:

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
Thanks :)
change
Code:
[a1].Resize(UBound(b, 1), 2) = b
to
Code:
[ae[B]15998[/B]].Resize(UBound(b, 1), 2) = b
 
Last edited:

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,379
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:

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,379
Just to recap my data starts in AE2 and would like the ends removed to column AF.
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
42,247
Office Version
365
Platform
Windows
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:

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
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
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,672
Office Version
365
Platform
Windows
@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
A
B
C
D
E
F
G
1
OiginalResult1
(UDF)
Result2 B2 copied down C2 copied downResult1
from VBA
Result2
from VBA
2
WA11711NWA11711N =Get_Item(A2) =SUBSTITUTE(A2,B2,"")WA11711N
3
WA20293RWA20293RWA20293R
4
WA22721N-WSDWA22721N-WSDWA22721N-WSD
5
WA20563-OSWA20563-OSWA20563-OS
6
WA20700NWA20700NWA20700N
7
WA20562-OSWA20562-OSWA20562-OS
8
WA13381N-6GWA13381N-6GWA13381N-6G
Sheet: Sheet4
 

Forum statistics

Threads
1,082,151
Messages
5,363,449
Members
400,737
Latest member
vipamuk

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top