Delete text (left or right) with VBA so I only keep a specific string

Question

Every day we get an Excel file which contains a database dump. Most of the file is being sorted in a VBA script that I made but I have one remaining problem that I'm unable to resolve. In one of the columns (A) I sometimes have 2 strings, I only like to keep one of those. The string I'd like to keep looks like "M1234 5678". The digits do change... The column sometimes has other text before or after the M1234 5678. I'd like to remove all that text so I only keep the needed string.

I already tried to use a search function trying to tackle the problem using a trim function and searching for a string that looked like "M#### ####". Had no luck going down this road. I have to admit that It has been 2 weeks ago that I have been jiggling with the code below that it might be messed up for the thing I tried to solve at that point.

    Sub TrimText()
       Dim FinalValue As String
       Dim lastStop As Long
       With Sheets("Blad2")
       lastStop = .Cells(.Rows.Count, "A").End(xlUp).Row
       For i = 2 To lastStop
       FinalValue = Trim(Cells(i, 1).Value)
       If InStr(FinalValue, "ALQ") > 0 Then
       Cells(i, 1).Value = Left(FinalValue, InStr(FinalValue, "M*"))
       End If
       Next
       End With
    End Sub

I hope to delete any text on the left or right of the M#### #### string.

Thanks for the help.

The digits change but does the string of interest length remain constant? — QHarr, May 13 '19 at 11:56
I recommend to do this with [regular expressions](https://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops) — Pᴇʜ, May 13 '19 at 11:56

QHarr · Answer 1 · 2019-05-13T12:43:30.917

2

You could use a regex pattern if string length remains constant

M\d{4}\s\d{4}

This could look like a function call (If condition removed)

Option Explicit
Public Sub TrimText()
    Dim FinalValue As String, lastStop As Long, i As Long, re As Object
    Set re = CreateObject("VBScript.RegExp")
    With ThisWorkbook.Worksheets("Blad2")
        lastStop = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastStop
            FinalValue = Trim(Cells(i, 1).Value)
            .Cells(i, 1).Value = ReplaceMatch(re, .Cells(i, 1).Value, "M\d{4}\s\d{4}")
        Next
    End With
End Sub

Public Function ReplaceMatch(ByVal re As Object, inputString As String, ByVal pattern As String) As String
    With re
        .Global = True
        .MultiLine = True
        .pattern = pattern

        If .test(inputString) Then
            ReplaceMatch = .Execute(inputString)(0)
        Else
            ReplaceMatch = inputString
        End If
    End With
End Function

edited May 13 '19 at 12:43

answered May 13 '19 at 11:57

QHarr

83,427
12
54
101

Just tried to test this. But no dice. I have to admit that I see the ALQ in the code and this would be incorrect. By the time I am sorting the M#### #### numbers from all other things their the only results left. – SeMo May 13 '19 at 12:26
Is ALQ present in the cells containing the strings of interest? If not, remove the If statement. Also, is there only a single space in between the numbers? – QHarr May 13 '19 at 12:27
There is always a single space between the digits. Their ticketnumbers. The ALQ is not relevant - way up in the code I already performed a search function to sort my rules containing M-numbers from other rules. All other rows are deleted. So basically I have rules left with M-numbers and sometimes other entries to the left or right of it. – SeMo May 13 '19 at 12:40
So, what happens when you remove the If? – QHarr May 13 '19 at 12:42
It is marking the With-statement when I remove the IF With ThisWorkbook.Worksheets("Blad2") – SeMo May 13 '19 at 12:47
I changed it around a bit - cause it kept highlighting the With-statement. It did work after removing the entire With-statement and removing te (dots) before "Cells" and "Rows". Will have a look on how it goes in different files. Thanks for helping me this far. – SeMo May 13 '19 at 12:57
My runs correctly with the With so I assume you don't have a Blad2 sheet – QHarr May 13 '19 at 14:00

score 0 · Answer 2 · answered May 13 '19 at 13:25

The way I got it to work is as following;

    Option Explicit
    Public Sub TrimText()
        Dim FinalValue As String, lastStop As Long, i As Long, re As Object
        Set re = CreateObject("VBScript.RegExp")
            lastStop = Cells(Rows.Count, "A").End(xlUp).Row
            For i = 2 To lastStop
                FinalValue = Trim(Cells(i, 1).Value)
                Cells(i, 1).Value = ReplaceMatch(re, Cells(i, 1).Value, "M\d{4}\s\d{4}")
            Next
    End Sub

    Public Function ReplaceMatch(ByVal re As Object, inputString As String, ByVal pattern As String) As String
        With re
            .Global = True
            .MultiLine = True
            .pattern = pattern

            If .test(inputString) Then
                ReplaceMatch = .Execute(inputString)(0)
            Else
                ReplaceMatch = inputString
            End If
        End With
    End Function

Thanks a lot for the help.

Delete text (left or right) with VBA so I only keep a specific string

2 Answers2