Problem with Identifying and despacing initials in a text string 2

[Felix18807]

I am trying to remove the spacing from strings containing initials for the purposes of record matching. To this end I created the function below.

This function creates a string for identifying possible initials within the string by converting into A's and spaces.

It is then SUPPOSED to replace initial spacing but for some reason decides to truncate my string.

It seems to fall down where there is a triple initial then a longer string.

An example of this would be

"A J T Trading" Becomes "T Trading"
but
"A W Andys" Becomes "AW Andys"

Can anyone spot where I am going wrong?

Function ReplaceText(StringIn As String) As String
Dim IDString As String
Dim TempString As String
Dim intpos As Integer

If Len(TempString) = 0 Then
ReplaceText = ""
Exit Function
End If

'Identifying Intitials
For intpos = 1 To Len(TempString)
If Mid(TempString, intpos, 1) = " " Then
IDString = IDString & " "
Else
IDString = IDString & "A"
End If
Next

Do Until InStr(IDString, "A A ") = 0 And (InStr(1, IDString, " A A")) = 0
If InStr(IDString, "A A ") > 0 Then
TempString = Replace(TempString, Chr(32), "", (InStr(1, IDString, "A A ")), 1)
IDString = Replace(IDString, "A A ", "AA ", 1, 1)
End If

If InStr(IDString, " A A") > 0 Then
TempString = Replace(TempString, Chr(32), "", (InStr(1, IDString, " A A")), 1)
IDString = Replace(IDString, " A A", " AA", 1, 1)
End If
Loop

ReplaceText = TempString
End Function

 

[SkipVought]

hi,

"A J T Trading" Becomes "T Trading"
but
"A W Andys" Becomes "AW Andys"

What is the LOGIC for this process, in plain words, not code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Felix18807]

With the quotation you gave I am demonstrating how the code is going wrong. I don't think I've explained myself very well!

What I want the code to do is change strings like "A J T Trading" to "AJT Trading" so I can see if this record exists on a master table. (I will run this code on both tables to provide a comparison string)

Thanks for reading my post

 

[SkipVought]

Your code logic is very convoluted...

Function ReplaceText(StringIn As String) As String
    Dim a, i As Integer, iInitCnt As Integer
    
    a = Split(StringIn, " ")
    
    For i = UBound(a) To 0 Step -1
        If Len(a(i)) = 1 Then
            iInitCnt = iInitCnt + 1
        End If
        If iInitCnt > 1 Then
            ReplaceText = a(i) & ReplaceText
        Else
            ReplaceText = a(i) & " " & ReplaceText
        End If
    Next
    ReplaceText = Trim(ReplaceText)
End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[jges]

I did a copy and paste to test your existing code, but it immediately exits because nothing has been assigned to TempString and this test causes it to exit:

If Len(TempString) = 0 Then
ReplaceText = ""
Exit Function
End If

Please post your most current version of the function.

 

[jges]

Nevermind, Skip nailed it.

 

[mintjulep]

Except for the special case of the first letter an initial is a letter with a space to the left AND a space to the right.

So why don't you test for that case?

Should be simple enough to do with MID(), but I think Regular Expressions would be useful.

 

[Felix18807]

I wish I was smart to enough to understand how your code works Skip but looking through the first 100 entries it looks good. Thanks alot all.

 

[SkipVought]

You intital post was EXTREMELY ambiguous and misleading. I think that's what mintjulip is referring to.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Felix18807]

I offer my abject apologies. Having re-read it I can see I was in a fit of pique when I wrote it at my own stupidity.

 

[combo]

From the vba help file:
Remarks
The return value of the Replace function is a string, with substitutions made, [!]that begins at the position specified by start[/!] and and concludes at the end of the expression string. It is not a copy of the original string from start to finish.

You can try a bit simpler solution (if necessary first remove doubled spaces):

Function ReplaceText2(StringIn As String) As String
Dim v
If StringIn <> "" Then
    v = Split(StringIn, " ")
    ReplaceText2 = v(0)
    For i = LBound(v) To UBound(v) - 1
        If Len(v(i)) = 1 And Len(v(i + 1)) = 1 Then
            ReplaceText2 = ReplaceText2 & v(i + 1)
        Else
            ReplaceText2 = ReplaceText2 & " " & v(i + 1)
        End If
    Next i
End If
End Function

combo

 

[combo]

Oh, I skipped quite a lot of replies. Only the remark to Replace function is fresh.

combo

 

[Felix18807]

Thanks combo you have shown me where I was going wrong thus lessening my frustration!

 

[SkipVought]

Function ReplaceText(StringIn As String) As String
    Dim a, i As Integer, iInitCnt As Integer
'[b][highlight]split the input string by the SPACE character--check VBA HELP[/highlight][/b]
    a = Split(StringIn, " ")
'[b][highlight]loop thru the elements of the a array from the LAST element to the FIRST[/highlight][/b]
    For i = UBound(a) To 0 Step -1
    '[b][highlight]if this is an initial, then start adding to a counter. Did this before you clarified the requirements[/highlight][/b]
        If Len(a(i)) = 1 Then
            iInitCnt = iInitCnt + 1
        End If
    
        If iInitCnt > 1 Then
        '[b][highlight]when the counter > 1 then stop using a SPACE[/highlight][/b]
            ReplaceText = a(i) & ReplaceText
        Else
        '[b][highlight]otherwise us a space a SPACE[/highlight][/b]
            ReplaceText = a(i) & " " & ReplaceText
        End If
    Next
    ReplaceText = Trim(ReplaceText)
End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}