How can I do a regex search and replace in a VBA excel macro?

Question

I'd like to create a VBA macro that replaces all cells in a worksheet with text strings in a time format (regular expression):

(1[0-2]|[1-9]):[0-5][0-9]:[0-5][0-9] [AP]M

with the cell address and worksheet name. I think the call will be akin too:

 Cells.Replace What:="1:23:45 AM",    
    Replacement:="=cell(""filename"")&cell(""Address"")", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
    False, ReplaceFormat:=False

But I'm hoping I can make the "What:=" argument a reg ex, or at least restricted to a time format.

How would I go about this?

---

Test Data: Save the following in CSV format:

00:00,04:27,00:36,04:31,00:00
00:00,00:00,04:18,01:07,10:06
00:00,00:00,00:00,00:00,00:00

Eventually the macro will delete all the zero times, and replace the other times with static text that is the evaluated formula =cell("filename")&"!"&cell("address")

---

Result of acting on the above input file (I would be saving the sheets as XLSX):

     [    A    ]   [     B     ]  [     C     ]  [     D     ]  [     E     ]
[1]                'Sheet1!$B$1   'Sheet1!$C$1   'Sheet1!$D$1
[2]                               'Sheet1!$C$2   'Sheet1!$D$2   'Sheet1!$E$2
[3]

For brevity, I stripped out the directory and file name that the =cell("filename") function returns, although the above is what I really would like.

Answer 1

I've updated my code formerly hosted here to

1. Remove any text fields in a user selected range that are '00:00
2. Replace any text "time fields" with the full path

(nb: In the end the Regex is overkill as a cell test for a value betwen 0.0 and 1.0 would suffice given the actual data format)

    '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 KillTime  


    Sub KillTime()
    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 strSht As String
    Dim X()

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

    strSht = ActiveWorkbook.Path & "\[" & ActiveWorkbook.Name & "]" & rng1.Parent.Name
    'remove '00:00
    rng1.Replace "00:00", vbNullString, xlWhole

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "^0\.\d+$"    
     '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
                   If objReg.test(X(lngRow, lngCol)) Then X(lngRow, lngCol) = strSht & rngArea.Cells(1).Offset(lngRow - 1, lngCol - 1).Address(0, 0)
                Next lngCol
            Next lngRow
            'Dump the updated array back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
               If objReg.test(rngArea.Value) Then rngArea.Value = strSht & rngArea.Address(0, 0)            
        End If
    Next rngArea

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

    Set objReg = Nothing
    End Sub

Answer 2

Since you are trying to replace a format, I'd do a replace based on a format. With a regex it seems like you'd be forced to deal with the underlying number.

I tested this in XL 2003 and 2010:

Sub ReplaceByFormat()
With ActiveSheet.Cells
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Application.FindFormat.NumberFormat = "h:mm AM/PM"
End With
End Sub

EDIT

First off I had a mistake above in placing the FindFormat at the end. It needs to be at the beginning (Doh).

There is no OR argument to the replace function. So below, I've just repeated the code for a second type of format.

This code assumes that the dates are all constants. If they are formulas you could fix with a find and replace in the vba. If they're a mix, you'll need to extend the code a bit:

Sub ReplaceByFormat()

With ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
    Application.FindFormat.NumberFormat = "h:mm AM/PM"
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    Application.FindFormat.NumberFormat = "m/d/yyyy"
    .Replace What:="", Replacement:="=cell(""filename"")&cell(""Address"")", _
             SearchFormat:=True, _
             ReplaceFormat:=False, _
             LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End With
End Sub