Can I find and move some number strings in Excel

jellevansoelen

New Member
Joined
Mar 1, 2021
Messages
29
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

Is it possible to find and move some number strings in a cell vallue?

Example:
moving barn
rebuild house 1990/212
moving house 1992/23 * changing
rebuild 54 barn 92/12

And look and move some number strings.
The following number strings where x = a different number
xxxx/xx
xxxx/xxx
xx/xx
xx/xxx

The end result must be:
moving barn1990/01
rebuild house1990/212
moving house * changing1992/23
rebuild 54 barn92/12

Hopefully someone can help me with this.

Tnx!
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
If the slash is only found in the number, and if you have at most 7 words in the phrase:

Book1
ABC
1moving barnmoving barn 
2rebuild house 1990/212rebuild house1990/212
3moving house 1992/23 * changingmoving house * changing1992/23
4rebuild 54 barn 92/12rebuild 54 barn92/12
Sheet1
Cell Formulas
RangeFormula
B1:B4B1=IF(C1<>"",SUBSTITUTE(A1," "&C1,""),A1)
C1:C4C1=IFERROR(TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",99)),AGGREGATE(15,6,{1,100,199,298,397,496,595}/ISNUMBER(FIND("/",TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",99)),{1,100,199,298,397,496,595},99)))),1),99)),"")


The number of words can be increased easy enough, but if the slash part isn't true, we'd need to find another way to do it.
 
Upvote 0
Hi,

Here's another way (no word limitations):

Book3.xlsx
ABC
1moving barn 1990/01moving barn1990/01
2rebuild house 1990/212rebuild house1990/212
3moving house 1992/23 * changingmoving house * changing1992/23
4rebuild 54 barn 92/12rebuild 54 barn92/12
5abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwuabc def ghi jkl mnop qr stuy xyz yui qwu123/4567
Sheet809
Cell Formulas
RangeFormula
B1:B5B1=TRIM(SUBSTITUTE(A1,C1,""))
C1:C5C1=TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",100)),FIND("/",SUBSTITUTE(A1," ",REPT(" ",100)))-100,200))
 
Upvote 0
Another option assuming / only occurs once
+Fluff 1.xlsm
ABC
1
2moving barn 1990/01moving barn1990/01
3rebuild house 1990/212rebuild house1990/212
4moving house 1992/23 * changingmoving house * changing1992/23
5rebuild 54 barn 92/12rebuild 54 barn92/12
6abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwuabc def ghi jkl mnop qr stuy xyz yui qwu123/4567
Test
Cell Formulas
RangeFormula
B2:B6B2=TRIM(SUBSTITUTE(A2,C2,""))
C2:C6C2=FILTERXML("<l><m>"&SUBSTITUTE(A2," ","</m><m>")&"</m></l>","//m[contains(.,'/')]")
 
Upvote 0
+ VBA solution:
VBA Code:
Function FixText(Txt) As String
  Static RegEx As Object
  If RegEx Is Nothing Then
    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Global = True
    RegEx.Pattern = "\d+\/\d+"
  End If
  FixText = Trim(Replace(RegEx.Replace(Txt, ""), "  ", " "))
End Function
Wb1
AB
1moving barnmoving barn
2moving barn 1990/01moving barn
3rebuild house 1990/212rebuild house
4moving house 1992/23 * changingmoving house * changing
5rebuild 54 barn 92/12rebuild 54 barn
6abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwuabc def ghi jkl mnop qr stuy xyz yui qwu
7rebuild house 1990/212 xyz 123/4567rebuild house xyz
Sheet1
Cell Formulas
RangeFormula
B1:B7B1=FixText(A1)
 
Upvote 0
+ VBA solution:
VBA Code:
Function FixText(Txt) As String
  Static RegEx As Object
  If RegEx Is Nothing Then
    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Global = True
    RegEx.Pattern = "\d+\/\d+"
  End If
  FixText = Trim(Replace(RegEx.Replace(Txt, ""), "  ", " "))
End Function
Wb1
AB
1moving barnmoving barn
2moving barn 1990/01moving barn
3rebuild house 1990/212rebuild house
4moving house 1992/23 * changingmoving house * changing
5rebuild 54 barn 92/12rebuild 54 barn
6abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwuabc def ghi jkl mnop qr stuy xyz yui qwu
7rebuild house 1990/212 xyz 123/4567rebuild house xyz
Sheet1
Cell Formulas
RangeFormula
B1:B7B1=FixText(A1)

Tnx for your answers.
I do something wrong, but don't know what.

I add your script in VBA.
vba script.PNG


And insert =FixText(A1) in cel B1 example =

Book1.xlsm
AB
1moving barn#NAME?
2moving barn 1990/01#NAME?
3rebuild house 1990/212#NAME?
4moving house 1992/23 * changing#NAME?
5rebuild 54 barn 92/12#NAME?
6abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwu#NAME?
7rebuild house 1990/212 xyz 123/4567#NAME?
Sheet1
Cell Formulas
RangeFormula
B1:B7B1=FixText(A1)


But i get #NAME?
Must I change something in that script?

Tnx,
Jelle
 
Upvote 0
I have also receive this script:

VBA Code:
Sub RegexReplace()

    Dim objRegExp As Object
    Dim colMatches As Object
    Dim s As String
    Dim vDB As Variant, vR() As Variant
    Dim r As Long, i As Long
    
    Set objRegExp = CreateObject("VBscript.RegExp")
    objRegExp.Pattern = "[0-9]{1,4}/[0-9]{1,3}"
    objRegExp.IgnoreCase = True
    objRegExp.Global = False
    
    vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
    r = UBound(vDB, 1)
    
    ReDim vR(1 To r, 1 To 1)
    For i = 1 To r
        s = vDB(i, 1)
        If objRegExp.Test(s) Then
           Set colMatches = objRegExp.Execute(s)
           vR(i, 1) = colMatches.item(0)
        End If
    Next i
    Range("c1").Resize(r, 1) = vR
End Sub

But it copy the number ranges.
And i want to move or replace it.
WuAzD.png


Like this:
Book1.xlsm
AB
2moving barn 1990/011990/01
3rebuild house 1990/2121990/212
4moving house 1992/23 * changing1992/23
Sheet1
 
Upvote 0
may Try this one
VBA Code:
Sub test()
    Dim a As Variant
    Dim i
    [b:c].ClearContents
    a = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 2)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\d+ {0,4}\/\d+ {0,3}"
        For i = 1 To UBound(a)
        On Error Resume Next
       a(i, 2) = .Execute(a(i, 1))(0)
       a(i, 1) = Trim(.Replace(a(i, 1), ""))
        Next
    End With
    Cells(1, 2).Resize(UBound(a), 2) = a
End Sub
 
Upvote 0
Solution
may Try this one
VBA Code:
Sub test()
    Dim a As Variant
    Dim i
    [b:c].ClearContents
    a = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 2)
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "\d+ {0,4}\/\d+ {0,3}"
        For i = 1 To UBound(a)
        On Error Resume Next
       a(i, 2) = .Execute(a(i, 1))(0)
       a(i, 1) = Trim(.Replace(a(i, 1), ""))
        Next
    End With
    Cells(1, 2).Resize(UBound(a), 2) = a
End Sub
Brilliant! Exactly what I need. Tnk you so much.
 
Upvote 0
You are welcome
And thank you for the feedback
Be happy & safe
 
Upvote 0

Forum statistics

Threads
1,215,575
Messages
6,125,616
Members
449,238
Latest member
wcbyers

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