Replace text using RegEx in Excel-VBA

Question

I have data in Excel like follows (one row here - one cell in Excel):

07 July 2015 12:02 – 14 July 2015 17:02
12 August 2015 22:02 – 01 September 2015 11:02

I want to write a macro that will delete all time info (e.g. "12:02") within a user's selection (multiple cells) to look like this:

07 July 2015 – 14 July 2015
12 August 2015 – 01 September 2015

When all "times" where similar ("00:00") this macro worked perfectly:

Sub delete_time()     
    Selection.Replace What:="00:00", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub

But then time-info stopped being uniform, so I decided to use RegEx. The problem is I can't find a proper way to do this on VBA. I tried this macro:

Sub delete_time()
    Dim RegEx As Object
    Set RegEx = CreateObject("VBScript.RegExp")
    On Error Resume Next

    RegEx.Global = True
    RegEx.Pattern = "\d\d\:\d\d"
    ActiveDocument.Range = _
        RegEx.Replace(ActiveDocument.Range, "")
End Sub

But it didn't work. Also tried "[0-9]{2}:[0-9]{2}" and "[0-9][0-9]:[0-9][0-9]" patterns but nothing changed. So the problem must be in my misunderstanding of VBA (I'm new to it).

Can anyone help?

vacip · Accepted Answer · 2015-12-28 10:55:46Z

8

The problem is with your selection.

ActiveDocument.Range = _
RegEx.Replace(ActiveDocument.Range, "")

ActiveDocument doesn't exist in the Excel namespace. We have ActiveWorkbook or ThisWorkbook, but what you need now is the Selection.

Use a for each loop to iterate all the cells in the current selection like this:

Dim myCell As Range

For Each myCell In Selection.Cells
  myCell.Value = RegEx.Replace(myCell.Value, "")
Next

answered Dec 28, 2015 at 10:55

vacip

5,4563 gold badges29 silver badges56 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

vacip Over a year ago

Your regex does leave some excess spaces though.

akarilimano Over a year ago

Thank you, this solution works perfect. You are also right about excess spaces, I've fixed that.

brettdj · Accepted Answer · 2015-12-29 13:22:00Z

A faster approach would be to combine your RegExp with a variant array:

'Press Alt + F11 to open the Visual Basic Editor (VBE)
'From the Menu, choose Insert-Module.
'Paste the code into the right-hand code window.
'Press Alt + F11 to close the VBE
'In Xl2003 Goto Tools … Macro … Macros and double-click KillDate

Sub KillDate()
    Dim rng1 As Range
    Dim rngArea As Range
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim objReg As Object
    Dim X()


    On Error Resume Next
    Set rng1 = Application.InputBox("Select range for the replacement", "User select", Selection.Address, , , , , 8)
    If rng1 Is Nothing Then Exit Sub
    On Error GoTo 0

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "\d\d\:\d\d"
    objReg.Global = True

   'Speed up the code by turning off screenupdating and setting calculation to manual
   'Disable any code events that may occur when writing to cells
    With Application
        lngCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Test each area in the user selected range

    'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
    For Each rngArea In rng1.Areas
        'The most common outcome is used for the True outcome to optimise code speed
        If rngArea.Cells.Count > 1 Then
           'If there is more than once cell then set the variant array to the dimensions of the range area
           'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
            X = rngArea.Value2
            For lngRow = 1 To rngArea.Rows.Count
                For lngCol = 1 To rngArea.Columns.Count
                    'replace the leading zeroes
                    X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString)
                Next lngCol
            Next lngRow
            'Dump the updated array sans leading zeroes back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
            rngArea.Value = objReg.Replace(rngArea.Value, vbNullString)
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
End Sub

Sam Gilbert · Accepted Answer · 2015-12-28 09:35:16Z

0

The easiest approach to me seems to be to use LEFT and RIGHT functions to extract the two separate timestamps, then to convert these timestamps to dates using TEXT function. Probably easiest in excel directly, but if you want to go down VBA route then example solution below:

' Taking a random date from Cell A1
DateRange = Range("A1")

' Extracting the first timestamp
FirstTimeStamp = Left(DateRange, Application.Find(" – ", DateRange))

' Converting to required date format
FirstDate = Application.Text(FirstTimeStamp, "dd-mmm-yyyy")

LastTimeStamp = Right(DateRange, Application.Find(" – ", DateRange))

LastDate = Application.Text(LastTimeStamp, "dd-mmm-yyyy")

answered Dec 28, 2015 at 9:35

Sam Gilbert

1,7023 gold badges23 silver badges43 bronze badges

1 Comment

akarilimano Over a year ago

Thanks for the reply, but it is not what I am looking for. I've edited my question with a desired result. I don't need to split text into two cells, I just want to replace some text in every cell of the selected range with an empty text. Splitting then merging seems like a dirty solution to me.

gab · Accepted Answer · 2022-04-15 09:25:19Z

0

Function ReplaceRegEx(str As String, pattern As String, newChar As String) As String 'recherche et remplace une expression reguliere par une chaine de char
Dim regEx As Object, found As Object, counter As Integer, F As Object
Set regEx = CreateObject("VBscript.RegExp")
regEx.Global = True
regEx.ignorecase = False
regEx.pattern = pattern
Set found = regEx.Execute(str)
counter = found.Count
If counter <> 0 Then
    For Each F In found
        str = Replace(str, F, newChar)
    Next F
End If
ReplaceRegEx = str
End Function

answered Apr 15, 2022 at 9:25

gab

1

2 Comments

Community Over a year ago

Your answer could be improved with additional supporting information. Please edit to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers in the help center.

SherylHohman Over a year ago

...also an explanation of how/why your code solves the OP's issue helps users hone in on the important bits of your solution, and facilitates learning. "Quality" answers are more likely to receive upvotes over time, as users learn something from your post that they can apply to their own issues. As mentioned, "code-only" answers are strongly discouraged on SO.

Collectives™ on Stack Overflow

Replace text using RegEx in Excel-VBA

4 Answers 4

2 Comments

Comments

1 Comment

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

2 Comments

Comments

1 Comment

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related