Multiple Replace in VBA

Viewed 209

How do I replace multiple words in a worksheet?

Words like: Da...da, Do...do, Dos, De... de.. etc.

How to adapt it in my spreadsheet called "Customers3"?

Public Function MyProper(MyString As String, Optional exceptions As Variant)

Dim c As Variant
If IsMissing(exceptions) Then
    exceptions = Array("a", "as", "e", "o", "os", "da", "das", "de", "di", "do", "dos",  _
      "CPF", "RG", "E-Mail")
End If

MyString = Application.Proper(MyString)

For Each c In exceptions
    MyString = Replace(" " & MyString & " ", " " & c & " ", " " & LCase(c) & " ", , , vbTextCompare)
Next c

MyProper = MyString

End Sub
2 Answers

One issue here:

MyString = Replace(" " & MyString & " ", " " & c & " ", " " & LCase(c) & " ", , , vbTextCompare)

every time you pass through the loop you add more spaces...

Also you have End Sub not End Function

Try this:

Public Function MyProper(MyString As String, Optional exceptions As Variant)

    Dim c As Variant
    If IsMissing(exceptions) Then
        exceptions = Array("a", "as", "e", "o", "os", "da", _
                           "das", "de", "di", "do", "dos", _
                           "CPF", "RG", "E-Mail")
    End If
    
    MyString = " " & Application.Proper(MyString) & " " 'in case exception at start/end
    
    For Each c In exceptions
        MyString = Replace(MyString, " " & c & " ", " " & LCase(c) & " ", , , vbTextCompare)
    Next c
    
    MyProper = Trim(MyString) 'remove any added spaces

End Function

Proper Portuguese

Option Explicit

Function MyProper(ByVal MyString As String) As String

    Const ExceptionsList As String _
        = "a,as,e,o,os,da,das,de,di,do,dos,CPF,RG,E-Mail"
    Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
    
    Dim SubStrings() As String
    SubStrings = Split(Application.Proper(MyString), " ")
    
    Dim cIndex As Variant
    Dim n As Long
    For n = 0 To UBound(SubStrings)
        cIndex = Application.Match(SubStrings(n), Exceptions, 0)
        If IsNumeric(cIndex) Then
            SubStrings(n) = Exceptions(cIndex - 1)
        End If
    Next n
    
    MyProper = Join(SubStrings, " ")

End Function


Sub MyProperAllWorksheets()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet
    Dim rg As Range
    Dim Data As Variant
    Dim rCount As Long, cCount As Long
    Dim r As Long, c As Long
    
    For Each ws In wb.Worksheets
        Set rg = ws.UsedRange
        rCount = rg.Rows.Count
        cCount = rg.Columns.Count
        If rCount > 1 Or cCount > 1 Then
            Data = rg.Value
        Else
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        End If
        For r = 1 To rCount
            For c = 1 To cCount
                On Error Resume Next
                Data(r, c) = MyProper(Data(r, c))
                On Error GoTo 0
            Next c
        Next r
        rg.Value = Data
    Next ws

End Sub
Related