Evaluate a range with Regex expression and avoid Offset-CodePudding

I have used this expression on the cell (K3) =RegexMatch(C3,"\b[Mm]od(?!erate).*\b[hH]\b").
Then I have used it on column (K) respectively with the values of column (C).
I need to use evaluate instead of this.
I have used the below code, But it dose not work as expected, as I got #VALUE! on all Range("K3:K" & LRow)
Notes:
1- I am using office 2016, So I have to use Index with Evaluate To force the return of an array.
2- I need to replace rng.Offset(0, -8).Address with a prober one if possible.

Public Function RegexMatch(str, pat) As Boolean
   With CreateObject("vbscript.regexp")
    .pattern = pat
    RegexMatch = .Test(str)
  End With
End Function

Sub Evaluate_Regex()

 Dim ws As Worksheet, rng As Range, LRow As Long

 Set ws = ActiveSheet
    
 LRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
      
 Set rng = ws.Range("K3:K" & LRow)    'the helper column
    
 rng.Value = Evaluate("INDEX(RegexMatch(" & rng.Offset(0, -8).Address & "\b[Mm]od(?!erate).*\b[hH]\b""),0)")
    
End Sub

CodePudding user response：

You may be looking to store you initial values in an array which you can loop over. For example given your sample data in linked question:

You could apply:

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim lr As Long, x As Long: lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim r_in As Variant: r_in = ws.Range("A2:A" & lr).Value
Dim r_out() As Variant: ReDim r_out(1 To UBound(r_in), 1 To 1)

For x = LBound(r_in) To UBound(r_in)
    r_out(x, 1) = RegexMatch(r_in(x, 1), "\b[Mm]od(?!erate).*\b[hH]\b")
Next

ws.Range("B2:B" & lr).Value = Application.Index(r_out, 0, 1) 'Application.Transpose would have limits

End Sub

Public Function RegexMatch(str, pat) As Boolean

Dim RE As Object: If RE Is Nothing Then Set RE = CreateObject("vbscript.regexp")

RE.Pattern = pat
RegexMatch = RE.Test(str)

End Function

A 2nd option would be to evaluate the formula directly over the entire range:

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim lr As Long, x As Long: lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

ws.Range("B2:B" & lr).Formula = "=RegexMatch(A2, ""\b[Mm]od(?!erate).*\b[hH]\b"")"

End Sub