3

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
4
  • 1
    How are you attempting to use this function? Commented Mar 2, 2021 at 19:11
  • I have several spreadsheets with customer data, names, addresses, and I used "ProperFunction" to get it right, but the particles were also capitalized with the first letter, and it shouldn't be. -Sorry, i don't know english very well Commented Mar 2, 2021 at 19:54
  • What happens when you use it in Excel? For example, =MyProper(A1)? Commented Mar 2, 2021 at 19:57
  • I need it to change in every spreadsheet and, as I'm still learning, I don't know how to insert it in the code. Could you please show me how? Commented Mar 2, 2021 at 20:06

2 Answers 2

2

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
Sign up to request clarification or add additional context in comments.

4 Comments

Okay, when I get home, I'll try. But in advance, thank you very much.
Hi I copied exactly as you posted, but nothing happened. I was using the bottom one, but it is very "heavy", it takes a long time to execute (there are many "Replaces"): .....>
Sub ProperCase() Dim rnge As range For Each rnge In Selection.SpecialCells(xlCellTypeConstants, xlTextValues).Cells rnge.Value = StrConv(rnge.Value, vbProperCase) rnge.Value = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(rnge.Value, _ " Da ", " da "), " Das ", " das "), " De ", " de "), " Dos ", " dos "), " Do ", " do "), " A ", " a "), " O ", " o "), _ " Os ", " os "), "Cpf", "CPF"), "Rg", "RG"), "E_mail", "E_Mail"), " E ", " e ") Next rnge End Sub
This works for me as a function - it doesn't "do" anything by itself.
1

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

4 Comments

Hi. I copied and pasted exactly as you sent, but nothing happened. The program didn't even think.
The procedure MyProperAllWorksheets is written for ThisWorkbook, i.e. the workbook containing this code. If you want to use it for another workbook, you should replace ThisWorkbook with ActiveWorkbook, or even better, with the workbook name, e.g. Workbooks("Test.xlsx").
Muito obrigado! (Thank you very much). Always wear the mask. God be with you.
Perfeito, Amigo! Deu certo! Muito muito muito obrigado. Deus cuidará de vc sempre! (Perfect, Friend! It worked out! Thank you very very much. God will take care of you always!).

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.