Can I find and move some number strings in Excel

[jellevansoelen]

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 barn	1990/01
rebuild house	1990/212
moving house * changing	1992/23
rebuild 54 barn	92/12

Hopefully someone can help me with this.

Tnx!

 

[Eric W]

If the slash is only found in the number, and if you have at most 7 words in the phrase:

Book1
	A	B	C
1	moving barn	moving barn
2	rebuild house 1990/212	rebuild house	1990/212
3	moving house 1992/23 * changing	moving house * changing	1992/23
4	rebuild 54 barn 92/12	rebuild 54 barn	92/12
Sheet1

Cell Formulas
Range	Formula
B1:B4	B1	=IF(C1<>"",SUBSTITUTE(A1," "&C1,""),A1)
C1:C4	C1	=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.

 

[jtakw]

Hi,

Here's another way (no word limitations):

Book3.xlsx
	A	B	C
1	moving barn 1990/01	moving barn	1990/01
2	rebuild house 1990/212	rebuild house	1990/212
3	moving house 1992/23 * changing	moving house * changing	1992/23
4	rebuild 54 barn 92/12	rebuild 54 barn	92/12
5	abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwu	abc def ghi jkl mnop qr stuy xyz yui qwu	123/4567
Sheet809

Cell Formulas
Range	Formula
B1:B5	B1	=TRIM(SUBSTITUTE(A1,C1,""))
C1:C5	C1	=TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",100)),FIND("/",SUBSTITUTE(A1," ",REPT(" ",100)))-100,200))

 

[Fluff]

Another option assuming / only occurs once

+Fluff 1.xlsm
	A	B	C
1
2	moving barn 1990/01	moving barn	1990/01
3	rebuild house 1990/212	rebuild house	1990/212
4	moving house 1992/23 * changing	moving house * changing	1992/23
5	rebuild 54 barn 92/12	rebuild 54 barn	92/12
6	abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwu	abc def ghi jkl mnop qr stuy xyz yui qwu	123/4567
Test

Cell Formulas
Range	Formula
B2:B6	B2	=TRIM(SUBSTITUTE(A2,C2,""))
C2:C6	C2	=FILTERXML("<l><m>"&SUBSTITUTE(A2," ","</m><m>")&"</m></l>","//m[contains(.,'/')]")

 

[ZVI]

+ VBA solution:

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
	A	B
1	moving barn	moving barn
2	moving barn 1990/01	moving barn
3	rebuild house 1990/212	rebuild house
4	moving house 1992/23 * changing	moving house * changing
5	rebuild 54 barn 92/12	rebuild 54 barn
6	abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwu	abc def ghi jkl mnop qr stuy xyz yui qwu
7	rebuild house 1990/212 xyz 123/4567	rebuild house xyz
Sheet1

Cell Formulas
Range	Formula
B1:B7	B1	=FixText(A1)

 

[jellevansoelen]

+ VBA solution:

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
	A	B
1	moving barn	moving barn
2	moving barn 1990/01	moving barn
3	rebuild house 1990/212	rebuild house
4	moving house 1992/23 * changing	moving house * changing
5	rebuild 54 barn 92/12	rebuild 54 barn
6	abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwu	abc def ghi jkl mnop qr stuy xyz yui qwu
7	rebuild house 1990/212 xyz 123/4567	rebuild house xyz
Sheet1

Cell Formulas
Range	Formula
B1:B7	B1	=FixText(A1)

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

I add your script in VBA.

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

Book1.xlsm
	A	B
1	moving barn	#NAME?
2	moving barn 1990/01	#NAME?
3	rebuild house 1990/212	#NAME?
4	moving house 1992/23 * changing	#NAME?
5	rebuild 54 barn 92/12	#NAME?
6	abc def ghi jkl mnop qr stuy 123/4567 xyz yui qwu	#NAME?
7	rebuild house 1990/212 xyz 123/4567	#NAME?
Sheet1

Cell Formulas
Range	Formula
B1:B7	B1	=FixText(A1)

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

Tnx,
Jelle

 

[jellevansoelen]

I have also receive this script:

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.

Like this:

Book1.xlsm
	A	B
2	moving barn 1990/01	1990/01
3	rebuild house 1990/212	1990/212
4	moving house 1992/23 * changing	1992/23
Sheet1

 

[mohadin]

may Try this one

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

 

[jellevansoelen]

may Try this one

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.

 

[mohadin]

You are welcome
And thank you for the feedback
Be happy & safe