Take a text string (user input) field and resolve/parse to use defined abbrevations

I am working on the below excel that I had some help in to get a initial draft together.

The intent is to have a second sheet with one colum of "Full Names" and the next adjacent column is it's "Abbreviation/Short Form".
The first sheet has a user input where the person enters a word string and this VBA should search for a "full name string" match and replace it with its Short Form/Abbrevation. Also any spaces and dashes are replaced with a _ (underscore).
The issue is when each defined word is entered independently it returns the "Abbreviation/Short Form" fine, but when you enter another name, it no longer works. It then seems to only look for direct matches of the single words and puts their abbrevations. I want it to make sure to use "full name" matches and not just the single word matches.

Screenshot shows an example of this bug. What can be done to fix this? I've attached the xlsm file also.

Attachment 17366Attachment 17367

Code:

---

    With Sheet2
        vList = .Range("A2", .Cells(Rows.Count, 2).End(xlUp))
        For l = LBound(vList) To UBound(vList)

'If Full name is found, Get the Abreviation
            If UCase(sInput) = vList(l, 1) Then sInput = vList(l, 2)
        Next l
'Else, 'cuz this loop does nothing if the first loop succeeded,
'For every occurrence of any Full name in sInput, Replace that with its abbreviation.

        For l = LBound(vList) To UBound(vList)
            sInput = Replace(UCase(sInput), vList(l, 1), vList(l, 2))
        Next l
    End With

---

The process the second loop does is:

Start with "AHU-1 Return Air Damper End Switch"

Replace "Damper" with DPR

Reult = AHU-1 Return Air DPR End Switch

Replace "End Switch" with END_SW

Result = AHU-1 Return Air DPR END_SW

replace "Return" with RTN

Result = AHU-1 RTN Air DPR END_SW

I think you will get what you say you want by merely not using the second loop.

This should also Return what you say you want

Code:

---

Function VBAX_Abbreviate(sInput As String)
Dim Found As Range

 Set Found = Sheet2.Range("A:A").Find(sInput).Offset(, 1).Value
If Not Found is Nothing Then VBAX_Abbreviate = [Replace, etc] Found.Offset(, 1).Value

End Function

---

Of course that is just another VLoopUp function.

I noticed you have

END SWITCH	END_SW
END SWITCH	ES
ES will never be used

ES will never be used

Hi SamT,
I am trying to use the second VBAX_Abbreviate but getting a #VALUE! error for the result field.
So if that were to run (sorry I am new to VBA's in general) I would get the correct result expected (screenshot shown).
Attachment 17368

The caveat is some strings from the user may not have the entire string be a full match, they could something like "AHU-1 Return Air Damper End Switch Setpoint"
which should be converted to AHU_1_RAD_ES_SP per "return air damper end switch = RAD_ES" and Setpoint = SP.

Quote:

---

something like "AHU-1 Return Air Damper End Switch Setpoint"
which should be converted to AHU_1_RAD_ES_SP

---

OK. That is different from what I thought you said in your first post. The VBAX_Abbreviation's codes won't return that. Your second loop should usually return the correct result. . . IF your Point Library was sorted by word count descending.

Code:

---

Function Abbreviate(ByVal sInput As String)
    Dim vList() As Variant
    Dim l As Long
   
    With Sheet2
        For l = LBound(vList) To UBound(vList)
            sInput = Replace(UCase(sInput), vList(l, 1), vList(l, 2))
        Next l
    End With
    Abbreviate = Replace(Replace(Trim(sInput), " ", "_"), "-", "_")
End Function

---

Run these, Arrange Sheet2, then try the above

Code:

---

Sub FixList()
Dim Cel As Range
For Each Cel In Sheet2.Range("A2").CurrentRegion
Cel = Trim(Cel)
Next
End Sub

Sub FixList2()
Dim Cel As Range
For Each Cel In Sheet2.Range("A2").CurrentRegion
Cel = Replace(Cel, "  ", " ")
Next
End Sub

Sub SortByWordCount()
Dim List
Dim Words
Dim Sorted
Dim Cnt As Long
Dim i As Long, j As Long, k As Long

List = Sheet2.Range("A2").CurrentRegion.Offset(1)

For i = LBound(List) To UBound(List)
  Words = Split(Trim(List(i, 1)), " ")
    Cnt = WorksheetFunction.Max(Cnt, UBound(Words))
Next i

Sorted = List 'Set Size of Sorted
k = LBound(Sorted)

For j = Cnt + 1 To 0 Step -1
  For i = LBound(List) To UBound(List)
    Words = Split(Trim(List(i, 1)), " ")
      If UBound(Words) = j Then
        Sorted(k, 1) = List(i, 1)
        Sorted(k, 2) = List(i, 2)
        k = k + 1
      End If
  Next i
Next j
 
 
Sheet2.Range("D2").Resize(UBound(Sorted) + 1, 2) = Sorted
End Sub

---

Thanks Sam,
I think I made the changes you noted above, but I am getting a #Value Error on the result cell B4 =Abbreviate(A4) , which as shown references the A4 user input cell for the string.

I do see after running the second sub code I have another set of columns with data, but are you stating I need to sort those by smallest to highest characters? I see I would have to likely use a =LEN(CELL) and then sort using that. Am I off base?

I've attached what I have based on this.

The Two columns created by Sub SortByWordCount should be moved to columns A and B.

I made it that way so it would not overwrite the originals.

Hi Sam, Thanks this seems to be working great. I did not however quite follow how the SortbyWordCount was being performed.
The concern is if we have individuals add new entries to the "Point Library" then we would have to run the Sub SortByWordCount and move over the columns again?

We don't like crossposting:

http://www.excelguru.ca/forums/showt...d-abbrevations

Quote:

---

Originally Posted by snb

We don't like crossposting:

http://www.excelguru.ca/forums/showt...d-abbrevations

---

... unless you at least tell us that you did and where, so that if the issue is solved on another forum we don't spend time on a non-problem

The other forums also appreciate knowing that you asked here on the BEST forum :devil2:

Quote:

---

Originally Posted by Paul_Hossler

... unless you at least tell us that you did and where, so that if the issue is solved on another forum we don't spend time on a non-problem

The other forums also appreciate knowing that you asked here on the BEST forum :devil2:

---

Sorry I didn't realize these were the same platform.

SortByWordCount first finds the longest string of words in the Point Library list of Terms = Cnt, (then it adds 1 to Cnt to compensate for the difference between Ubound and Count.)

Then it goes thru the list of Matching Terms looking for Terms with Word counts = Cnt, decrementing Cnt on each loop.

In each loop of Cnt, it adds those matching word count Terms to the sorted list. All 5 word Terms, then all 4 word terms, then 3 word terms , etc.

Quote:

---

The concern is if we have individuals add new entries to the "Point Library" then we would have to run the Sub SortByWordCount and move over the columns again?

---

IF they add words out of word count order, you will need to resort the list. However, if you change "D2" below, to "A2", the Sorted list will replace the existing list and you won't have to move any columns.

Code:

---


Sheet2.Range("D2").Resize(UBound(Sorted) + 1, 2) = Sorted

---

It is possible to intercept any Selection Changes in Point Library and force Users to use some VBA to insert new Terms.

If you don't mind the time it takes you can add a call SortByWordCount to the Sub Abbreviations. IMO, it's not worth it. The best way to handle "Wild and Crazy" users is to develop UserForms to handle all User Interaction.



BTW, please see: What is multiposting?

Quote:

---

Originally Posted by smjbill

Sorry I didn't realize these were the same platform.

---

In fact they are NOT at all the same platform.
Read www.excelguru.ca/content.php?184 to understand what cross posting without links is about

Also cross posted at http://www.excelforum.com/showthread...t=#post4504602

Sorry, I've requested the other posts on the other forums be deleted.

Quote:

---

Originally Posted by SamT

SortByWordCount first finds the longest string of words in the Point Library list of Terms = Cnt, (then it adds 1 to Cnt to compensate for the difference between Ubound and Count.)

Then it goes thru the list of Matching Terms looking for Terms with Word counts = Cnt, decrementing Cnt on each loop.

In each loop of Cnt, it adds those matching word count Terms to the sorted list. All 5 word Terms, then alAttachment 17387l 4 word terms, then 3 word terms , etc.



IF they add words out of word count order, you will need to resort the list. However, if you change "D2" below, to "A2", the Sorted list will replace the existing list and you won't have to move any columns.

Code:

---


Sheet2.Range("D2").Resize(UBound(Sorted) + 1, 2) = Sorted

---

It is possible to intercept any Selection Changes in Point Library and force Users to use some VBA to insert new Terms.

If you don't mind the time it takes you can add a call SortByWordCount to the Sub Abbreviations. IMO, it's not worth it. The best way to handle "Wild and Crazy" users is to develop UserForms to handle all User Interaction.

---

Added new entry to the name generator (out of order at the bottom) of the list on the Point Library, and ran all modules (Fixlist,Fixlist2,SortByWordCount), and kept it so it makes a second set of columns, I do see it shows up in the second set of columns sorted.
But when putting the new entry is ACTIVE ZONE TEMPERATURE SETPOINT in the user input field, the abbreviation wont show up. I've uploaded this file with the new entry.


Attachment 17387

Interesting, I not sure what made it work after entering another new entry, but I did sort the A B column in the Point Library in Alphabetical order then ran the modules again. After this both the Active Zone Temperature Setpoint and the other new addition worked....

:thumb

Quote:

---

Originally Posted by SamT

:thumb

---

I am having issues adding new entries then running the fix/sort modules and the Abbrev function not working any longer. I know you mentioned a UserForm would likely help for new entries. Would you be able to help with adding one that adds a new pair (name and associated abbrevation).

Thank you for all your help thus far.

The basic UserForm needs two TextBoxes for the new Entry and new Abbreve.
Three CommandButtons, Clear/Cancel, Commit/Save, and Quit.
The TextBox Event code to use is the Exit Event.

The UserForm ShowModal Property must be False, so the User can scroll the Worksheet while viewing the UserForm.

On Exiting either TextBox, the code must first Trim and delete extra spaces, then the code must search the existing lists for matching values and warn the user.

The code must determine the WordCount of the new Entry, then step thru the existing list looking for the first Term with the same WordCount.

Given that the lists were sorted Alphabetically before they were sorted by word count, then the code must step thru the existing list till it finds the first entry that is alphabetically larger than the new entry. At that point, insert a Row into the List and add the new Entry and Abbreve.

To that end, let's first turn the WordCount Code into a general purpose Function

Code:

---

Function CountWords(Term As String) As long
'Don't assume all extra spaces have been removed from Term
Term = Trim(Term)
Do While InStr(Term, "  ") 'Double space
  Term = Replace(Term, "  ", " ")
Loop

 CountWords =  UBound(Split(Term, " ")) + 1
 End Function

---

Example Usage:

Code:

---

WordCount = CountWords(tbxEntry)

---