0
votes

I need to find a string pattern of varying length and add a comma and space after that string pattern. For example, Search for the string "Cat. 123" I want to replace that string with the value "Cat. 123, " (i.e. add a comma and then a space at the end of "Cat. 123"). I am using Mac Office 2011 so any code has to work with the Mac version of Excel.

I've tried using Replace.Regex, Split and all other Replace functions I could find. The code below is the best I have come up with in order to do this but it's not adding the comma and the space to the end of the string pattern.


Sub test()
    Dim r As Range, x, y

    Set r = Cells.Find("?*, Cat. *", , , 1)
    If Not r Is Nothing Then
        Do
            ' Search for any string with the pattern Cat. 123, Cat. 14, etc
            x = Split(r.Value, " Cat. ")
            If x(UBound(x)) Like "* *" Then
             ' Replace string Cat. 123 with the new string Cat. 123, 
                y = Split(x(UBound(x)))
                x(0) = "Cat. " & y(0) & ", " & x(0)
                x(UBound(x)) = y(1)
            Else
                y = x(UBound(x))
                x(0) = "Cat. " & y & ", " & x(0)
                x(UBound(x)) = ""
            End If
            r.Value = Join(x)
            Set r = Cells.FindNext(r)
        Loop Until r Is Nothing
    End If
  End Sub

So the output of each cell that contains a pattern like the following examples: "Cat. 123" "Cat. 1" "Cat. 34" "Cat. 4567", would be changed to "Cat. 123, " "Cat. 1, " "Cat. 34, " "Cat. 4567, " NOTE: The original string will always have a period after the word "Cat" and will then be followed by a space and then followed with a single digit all the way up to four digits as shown above.

1

1 Answers

1
votes

Give this a try (this time without vbscript dependent regex):

Sub tgr()

    Dim aData As Variant
    Dim sTemp As String
    Dim lCatLoc As Long
    Dim lNextSpace As Long
    Dim i As Long, j As Long

    With ActiveSheet.UsedRange
        If .Cells.Count = 1 Then
            ReDim aData(1 To 1, 1 To 1)
            aData(1, 1) = .Value
        Else
            aData = .Value
        End If
        For i = 1 To UBound(aData, 1)
            For j = 1 To UBound(aData, 2)
                If Len(aData(i, j)) > 0 Then
                    If aData(i, j) Like "*Cat. [0-9]*" Then
                        lCatLoc = InStr(1, aData(i, j), "Cat. ", vbTextCompare)
                        lNextSpace = InStr(lCatLoc + 5, aData(i, j) & " ", " ", vbTextCompare)
                        sTemp = Mid(aData(i, j), lCatLoc, lNextSpace - lCatLoc)
                        If Right(sTemp, 1) <> "," Then aData(i, j) = Replace(aData(i, j), sTemp, sTemp & ", ")
                    End If
                End If
            Next j
        Next i
        .Value = aData
    End With

End Sub