[VBA][XL2010] Search and Replace with Multiple Search Values

[chartzell]

I'd like to know how to do a search and replace by checking each cell in a given column against an array of values provided by the user. Specifically, I have a user that needs to find several (but not all) model numbers with the format of "\b([0-9]?[A-Z]{2,3}).*" and add letters to the end of the parenthetical string.

I have limited experience with VBA (I'd normally pull out the column and handle it with sed, but that's not an option for my user) so any snippets of code, relevant resource pages, or suggestions of alternate ways to handle the problem would be greatly appreciated.


Edit:

This issue has been solved (thanks in large part to hippiehacker). For anyone searching for a similar problem, here is my code. It's VBA macro that selects a column based on the value in the header, checks each cell in that column for multiple values given by the user, and does a regex replace on the contents of the cell if it finds any of the values given previously.

Sub AddZ()
    Dim lRow, lCol As Long
    Dim myArray() As Variant, myArrayPointer As Long '//myArray will hold user-input search terms
    Dim uiValue As Variant
    Dim oRegReplace As Object
    Set oRegReplace = CreateObject("VBscript.regexp")
    
    oRegReplace.Pattern = "\b([0-9]?[A-Z]{1,3})[^ \b]" '//RegEx search pattern to be used
    oRegReplace.Global = True '//Set this to false to disable global replace (will only replace first occurrence)
    
    lRow = 2
    lCol = Rows(1).Find(What:="*Model*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    '//^ This line searches column headers for "*Model*" and assigns the column number to lCol

    ReDim myArray(1 To 1)
    myArrayPointer = 1

    uiValue = 1

    Do
        uiValue = Application.InputBox("Model Number to Modify")

        If myArrayPointer > UBound(myArray) Then
            ReDim Preserve myArray(1 To myArrayPointer)
        End If
        myArray(myArrayPointer) = uiValue

        If uiValue <> False Then
            myArrayPointer = myArrayPointer + 1
        End If

        Loop Until uiValue = False

    If myArrayPointer = 0 Then
        MsgBox "Nothing Entered"
    Else
        ReDim Preserve myArray(1 To myArrayPointer)
    End If
    
    Do
        For Each ModelNum In myArray()
            If ModelNum = ActiveSheet.Cells(lRow, lCol).Value Then
                CurrModel = ModelNum
                temp = oRegReplace.Replace(ActiveSheet.Cells(lRow, lCol).Value, "$1" & "Z") '//This is where the replace happens
                ActiveSheet.Cells(lRow, lCol).Value = temp
                Exit For
            End If
        Next
        
        lRow = lRow + 1
    Loop Until Len(Cells(lRow, lCol)) = 0

End Sub

Cody Hartzell
System Administrator at
Clarion Bathware

 

[CharlesChuckieCharles]

a Couple of examples might help get responses

what i think i'm seeing is first char 0 to 9 followed by any char followed by a character A to Z ( in Uppercase?) followed by a 2 or a 3?? .*

^ what does this mean??

 

[hippiehacker]

put this UDF in a module code

Function RegexContains(ByVal find_in As String, _
                       ByVal find_what As String, _
                       Optional IgnoreCase As Boolean = False) As Boolean

Application.ScreenUpdating = False
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.Pattern = find_what
RE.IgnoreCase = IgnoreCase
RE.Global = True
RegexContains = RE.Test(find_in)

Application.ScreenUpdating = True

End Function

you can use the function like

=RegexContains(A1;"^([0-9]?[A-Z]{2,3}).*")

where A1 is hosting your string

 

[hippiehacker]

a Couple of examples might help get responses

what i think i'm seeing is first char 0 to 9 followed by any char followed by a character A to Z ( in Uppercase?) followed by a 2 or a 3?? .*

^ what does this mean??

the ^ means look at start of the string
look at regular expressions don't mix it with the like statement!!

check
Microsoft Beefs Up VBScript with Regular Expressions

 

[chartzell]

Sorry, I guess I should have clarified that to begin with. It's a string that at the beginning (^) may or may not have a number ([0-9]?) followed by 2 or 3 capital letters ([A-Z]{2,3}), and I want to match anything (.*) that comes afterward.

Edit: Thanks for the code snippet hippiehacker, I'll see if I can work that into what I'm doing.

 

[hippiehacker]

we can change the udf to add the string you want just tell me how the string should look afterwards (when the string has been added)

 

[chartzell]

we can change the udf to add the string you want just tell me how the string should look afterwards (when the string has been added)

Sorry for the regex confusion, I have trouble keeping the different flavors straight. If you're familiar with sed, I'd like the equivalent of "s/\b[0-9]*[A-Z]\{1,3\}/&Z/" (I didn't realize I'd have to match a boundary later in the string when I posted, and forgot I had to escape { and }).

If you're not familiar with it, I want to find what I stated in my last post, with the exception of matching a word boundary instead of only the beginning of a line, and (for now, I can modify as needed) just add a "Z" after the 1-3 capital letters.

e.g.
RE2054 to REZ2054
RE7403LX or RE7403RX to REZ7403LX or REZ7403RX
4T40LT or 4T40RT to 4TZ40LT or 4TZ40RT

 

[hippiehacker]

do you know if the searchstring always starts in at the beginning of the main string?

otherwise we need another approach to find the position as well like

Function MYMATCH(strValue As String, strPattern As String, Optional blnCase As Boolean = True, Optional blnBoolean = True) As String
    Dim objRegEx As Object
    Dim strPosition As Integer
    Dim RegMC

    ' Create regular expression.
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Pattern = strPattern
        .IgnoreCase = blnCase
        If .test(strValue) Then
            Set RegMC = .Execute(strValue)
            MYMATCH = RegMC(0).firstindex + 1
        Else
            MYMATCH = "no match"
        End If
    End With
End Function

Sub TestMe()
    MsgBox MYMATCH("test 1", "\d+")
End Sub

 

[chartzell]

The contents of the cell will always begin with the given format, but some cells contain 2 occurrences of the string I need to find and replace, for instance "RE7403LX or RE7403RX" would be contained in a single cell.

Edit:

Maybe it would help if I gave you a more complete picture of what I need to do and what I have so far.

Sub AddZ()
    Dim lRow As Long
    Dim lCol As Long
    Dim vModelNum As Variant
    
    lRow = 2
    lCol = Rows(1).Find(What:="*Model*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    
    Do
        Loop Until Len(Cells(lRow, lCol)) = 0
        
        '// Check to see if the cell contains any model number in a given array (modelnums supplied by User)

        If (Cell does contain any of the model numbers) Then
                '// Regex search and replace to add "Z" to the beginning portion of each occurrence in the cell
        End If
        
        lRow = lRow + 1

End Sub

The commented portions are things I don't have code written for yet, since I am not at all fluent in VBA (most of my experience with it is writing small hackish macros and modifying existing code).

 

[hippiehacker]

just to make sure we might come closer to the solution or even not
try

Function RegExpTest(strValue As String, strPattern As String, strAdd As String)
    Dim regEx, Match, Matches, s

    ' Create the regular expression.
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = strPattern
    regEx.IgnoreCase = True
    regEx.Global = True

    ' Do the search.
    Set Matches = regEx.Execute(strValue)

    ' Iterate through the Matches collection.
    s = ""
    For Each Match In Matches
      's = s & "Match found at position "
      's = s & Match.FirstIndex + 1 & ".  "
      's = s & "Match Length is "
      's = s & Match.Length & "."
      's = s & vbCrLf
      If u = "" Then
      s = Left(strValue, Match.FirstIndex + 2) & strAdd
      t = Right(strValue, Len(strValue) - (Match.FirstIndex + 1 + 2))
      u = s & t
      Else
      s = Left(u, Match.FirstIndex + 2) & strAdd
      t = Right(u, Len(u) - (Match.FirstIndex + 1 + 2))
      u = s & t
      End If
    Next

    RegExpTest = u
End Function

Sub regex3()
MsgBox (RegExpTest("RE7403LX or RE7403RX", "[A-Z][A-Z][0-9][0-9][0-9][0-9][A-Z][A-Z]*", "z"))
End Sub