0

I have string name with salutation

DATIN SERI PADUKA JOHN DOE with actual name is JOHN DOE

and i have list excel for salutation :

DATIN SERI
DATIN SERI PADUKA

Currently using substitute function from VBA :

For index=2 to totalRow

SalutationArray = Split(ws.Range("A"&index), " ")
For N = 0 to UBound(SalutationArray)
strSalutation = SalutationArray(N)
ws.Range("B" & index) = WorksheetFunction.Substitute(strName,strSalutation,"")

Next index

The output result is PADUKA JOHN DOE with space in front

how to achieve output result is only JOHN DOE with that list salutation

Improve this question
1
  • 2
    Sort your "salutation" list by descending length (longest first) and exit the loop when a replacement has been made. It's not clear from your question what your data looks like though, and why split ws.Range("A"&index) on space and not vbLf (if the values are all in the same cell) Commented Oct 18, 2024 at 15:58

3 Answers 3

Reset to default
2

1) to get rid of the leading blanks, just use the function Trim

Trim(WorksheetFunction.Substitute(strName,strSalutation,""))

2) Instead of WorksheetFunction.Substitute, you should use the native VBA function Replace. This is not only much faster, but ensures also that the code would work in any VBA environment (eg VBA for Word or Powerpoint).

Trim(Replace(strName, strSalutation, ""))

3) With your given example, you could get a bad surprise:
Look at the input DATIN SERI PADUKA JOHN DOE. Your code starts to run, and the first entry in the list is DATIN SERI. The code will remove that from the name, leaving PADUKA JOHN DOE.
Now you look at the second entry DATIN SERI PADUKA of the list. This is no longer part of the name, so the term PADUKA will stay and you end up with PADUKA JOHN DOE.

Either change the order in your list (put the longest entry to the top), or add another entry PADUKA into the list (but then the entry DATIN SERI PADUKA is no longer needed).

Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

1

With this code create a dictionary of the salutations by word. After it the code removes all words found. Apply as a function and the return value will be the pure name.

Sub sallute()  'function sallute(inp as string) as string  REPLACE
purename = "DATIN SERI PADUKA JOHN DOE"  'purename=inp  REPLACE
Set salrng = Range("A1:A2")  'the range of salutations
Dim dict As Scripting.Dictionary
Set dict = New Dictionary
For Each cel In salrng

spl = Split(cel, " ", , vbTextCompare)
For i = 0 To UBound(spl)
If Not dict.Exists(spl(i)) Then
dict.Add spl(i), spl(i)
End If
Next i
Next cel

On Error Resume Next  'eliminate missing salutation
For i = 0 To dict.Count - 1

strSalutation = dict.Keys(i)
purename = WorksheetFunction.Substitute(purename, strSalutation, "")
Next i
On Error GoTo 0
purename = Trim(purename)
'sallute=purename   REPLACE
End Sub

UPDATE

To enable the usage of partially identical salutations can several solutions applied, for me seems to enhance the check with the leading/trailing spaces and replace the found word with a space. For this apply the following mod: (in 3 lines)

Sub sallute()  'function sallute(inp as string) as string  REPLACE
purename = " " & "DATIN SERI PADUKA JOHN DOE" & " " 'purename=inp  REPLACE MOD
Set salrng = Range("A1:A2")  'the range of salutations
Dim dict As Scripting.Dictionary
Set dict = New Dictionary
For Each cel In salrng

spl = Split(cel, " ", , vbTextCompare)
For i = 0 To UBound(spl)
If Not dict.Exists(spl(i)) Then
dict.Add spl(i), spl(i)
End If
Next i
Next cel

On Error Resume Next  'eliminate missing salutation
For i = 0 To dict.Count - 1

strSalutation = " " & dict.Keys(i) & " "    'MOD
purename = WorksheetFunction.Substitute(purename, strSalutation, " ")   'MOD
Next i
On Error GoTo 0
purename = Trim(purename)
'sallute=purename   REPLACE
End Sub
Improve this answer

4 Comments

I'd also recommend the use of Dictionaries. While the OP only lists uppercase words in the salutation list, I would worry about running into mixed case. So perhaps converting all Dictionary keys to lowercase at creation, and only search using the converted lowercase word.
@PeterT Or maybe just set the CompareMode property to vbTextCompare?
Try this one actually found another issue when case salutation between BRIG JEN and BRIG JENERAL will left me with ERAL purename, with this i add additional step to split purename to array by space and match word by word to dictionary, if match do the subtitue and left me with actual purename no issue.
@Aliga Pls. find the improved code. It is nearly the same as yours. Another way to check the length of the founc word, but it is more complicated to code.
0

Assuming you list of salutations is in a vertical range in the worksheet named Salutations, the following code uses Regular Expressions to remove all the Salutations:

Option Explicit
Function ReplaceSalutations(S As String) As String
    Dim RE As Object
    Dim sPat As String, vPat As Variant
vPat = [Salutations]

'Convert Salutations into a Pipe-delimited string of the individual words or phrases
'If you use Phrases, they must be sorted by length order longest to shortest
'Also, there must be more than a single entry in Salutations
sPat = Join(WorksheetFunction.Transpose(vPat), "|")
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = True
    .Pattern = sPat
    ReplaceSalutations = Trim(RE.Replace(S, ""))
End With
End Function
Improve this answer

1 Comment

@TimWilliams Yes, but not if the words are used individually. I'll make that more clear in my answer.

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.