PDA

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



smjbill
10-18-2016, 02:37 PM
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.

1736617367

SamT
10-18-2016, 03:26 PM
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

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

smjbill
10-18-2016, 03:57 PM
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).
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.

SamT
10-18-2016, 11:10 PM
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.


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

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

smjbill
10-19-2016, 02:52 PM
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.

SamT
10-19-2016, 04:00 PM
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.

smjbill
10-20-2016, 11:08 AM
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?

snb
10-20-2016, 11:55 AM
We don't like crossposting:

http://www.excelguru.ca/forums/showthread.php?6872-Take-a-word-string-and-parse-out-and-result-in-defined-abbrevations

Paul_Hossler
10-20-2016, 12:25 PM
We don't like crossposting:

http://www.excelguru.ca/forums/showthread.php?6872-Take-a-word-string-and-parse-out-and-result-in-defined-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:

smjbill
10-20-2016, 12:36 PM
... 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.

SamT
10-20-2016, 12:45 PM
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.


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.


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? (http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3)

arthurbr
10-20-2016, 11:40 PM
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

arthurbr
10-20-2016, 11:47 PM
Also cross posted at www.excelforum.com/showthread.php?t=1159514&p=4504602&highlight=#post4504602

smjbill
10-21-2016, 12:32 PM
Sorry, I've requested the other posts on the other forums be deleted.

smjbill
10-21-2016, 01:34 PM
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 al17387l 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.


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.


17387

smjbill
10-21-2016, 02:19 PM
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....

SamT
10-21-2016, 05:33 PM
:thumb

smjbill
10-23-2016, 03:14 PM
: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.

SamT
10-24-2016, 07:00 PM
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


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:

WordCount = CountWords(tbxEntry)