I have a list of people getting aid from my organization.
Some register their names with different spelling or different order.
Here is an example
**Names** **ID**
Ahmed mohammed Saleh 3576158946 Personal ID
Waleed Khalid Ali 5478698645 Personal ID
Fatima Nader Aljalal 4684325986 Personal ID
Hussan Huessien Ahmed 778569 Family ID
*Ahmed Mohamed Salah* 698745 Family ID
*Waleed Ali Khalid* No ID
The last two in the list have registered twice.
My data has 4000 rows and I have to find the partial duplicates.
One way to reduce the difficulty of the task is to hash the names to a sorted string of lowercase characters with duplicate characters, spaces and vowels removed. You could then compare the hashed names to determine similarity. In the example below we are fortunate that we get exact matches but it would not be impossible to write a further function that checked if the hashed names differed by one, two or more characters, and in fact that the original names were a reasonable match.
Option Explicit
Private Type State
CharArray As Variant
End Type
Private s As State
Public Sub test()
Initialise
Debug.Print "Ahmed mohammed Saleh", ConvertNameToHash("Ahmed mohammed Saleh")
Debug.Print "Ahmed Mohamed Salah", ConvertNameToHash("Ahmed Mohamed Salah")
Debug.Print "Waleed Khalid Ali", ConvertNameToHash("Waleed Khalid Ali")
Debug.Print "Waleed Ali Khalid", ConvertNameToHash("Waleed Ali Khalid")
End Sub
Public Sub Initialise()
s.CharArray = Split("b,c,d,f,g,h,j,k,l,m,n,p,q,r,s,t,v,w,x,y,z", ",")
End Sub
Public Function ConvertNameToHash(ByVal ipName As String) As String
Dim myChars As String
Dim myName As String
myName = LCase$(ipName)
Dim myChar As Variant
For Each myChar In s.CharArray
If InStr(myName, myChar) > 0 Then
myChars = myChars & myChar
End If
Next
ConvertNameToHash = myChars
End Function
The output from the above code was
Ahmed mohammed Saleh dhlms
Ahmed Mohamed Salah dhlms
Waleed Khalid Ali dhklw
Waleed Ali Khalid dhklw
Related
I need help on vba code to reorder the parts of a name. Sometimes there is a suffix (Jr, Sr, I, II, III, IV), and that is the part I can't figure out. There is no list that I need to loop thru. The elements of the name could look like this: Johnson, Joseph Allen Jr
This code works for getting the last name moved to the end, but now I need to trim & move the suffix to the right after the last name.
Range("A1") = Trim(StrReverse(Split(StrReverse(Range("A1")), ",")(0)) & " " _
& StrReverse(Split(StrReverse(Range("A1")), ",")(1)))
Result: Joseph Allen Jr Johnson
Result Required: Joseph Allen Johnson Jr
Thanks for any help!
So if your inputs are like Johnson, Joseph Allen Jr then you could set up an array/collection with the suffixes you want to check against. Then before you move the last name use
Dim i as Variant
Dim suffixArray as String()
Dim nameString as String
Dim suffixString as String
Dim arrayEntryLength as Long
suffixArray(0) = "Jr"
suffixArray(1) = "Sr"
suffixArray(2) = "I"
suffixArray(3) = "II"
...
for each i in suffixArray
nameString = "Johnson, Joseph Allen Jr" 'or use Cells(1,"a").value
arrayEntryLength = len(suffixArray(i))
if Right(nameString, arrayEntryLength) = suffixArray(i) then
suffixString = suffixArray(i)
nameString = left(nameString, len(nameString)-arrayEntryLength)
end if
next i
'move the last name of nameString
nameString = nameString & " " & suffixString
'rest of code
The full name is a unparsed string and manipulating "Suffix" as mentioned above by Chris H may be a suitable way. Here is Fullname content model in Outlook contact Item: https://learn.microsoft.com/en-us/office/vba/api/outlook.contactitem.fullname. Building an array of known suffixes will solve this in general. Watch out: the suffix may such as King Louis XVII, etc. is some historical context.
I have an issue with trim the string method NOT working completely I have reviewed MS Docs and looked of forums but with no luck... It's probably something simple or some other parameter is missing. This is just a sample,
Please note I need to pick up text before and after #, hence than I was planning to use # as a separator. Trim start # #, Trim End # #. I can't use The last Index or Replace per my understanding they have no direction. But perhaps I am misunderstood MS docs regards to trim Start and End as well...
thanks!
Dim str As String = "this is a #string"
Dim ext As String = str.TrimEnd("#")
MsgBox(ext)
ANSWER:
I found a solution for my problem, if you experience similar please see below:
1st: Trim end will NOT scan for the "character" from the Right as I originally thought it will just remove it from the right.... A weak function I would say:). IndexOf direction ID would be a very simple and helpful. Regards My answer was answered by Andrew, thanks!
Now there is another way around it if you try to split a SINGLE String INTO - QTY based on CHARACTER separation and populate fields accordingly.
Answer is ArrayList. Array List will ID each String so you can avoid repeated populations and etc. After you can use CASE or IF to populate accordingly.
Dim arrList As New ArrayList("this is a # string".Split("#"c)) ' Will build the list of your strings
Dim index As Integer = 1 ' this will help us index the strings 1st, 2nd and etc.
For Each part In arrList 'here we are going thru the list
Select Case index ' Here we are identifying which field we are populating
Case 1 '1st string(split)
MsgBox("1 " & arrList(0) & index) '1st string value left to SPLIT arrList(0).
Case 2 '2nd string(split)
MsgBox("2 " & arrList(1) & index) '2nd string value left to SPLIT arrList(1).
End Select
index += 1 'Here we adding one shift thru strings as we go
Next
Rather than:
Dim str As String = "this is a #string"
Dim ext As String = str.TrimEnd("#")
Try:
Dim str As String = "this is a #string"
Dim ext As String = str.Replace("#", "")
Dim str As String = "this is a #string"
Dim parts = str.Split("#"c)
For Each part in parts
Console.WriteLine($"|{part}|")
Next
Output:
|this is a |
|string|
Maybe there is a better way as we know there are multiple things to do the same thing.
The solution I used is below:
Dim arrList As New ArrayList("this is a # string".Split("#"c)) ' Will build the list of your strings
Dim index As Integer = 1 ' this will help us index the strings 1st, 2nd and etc.
For Each part In arrList 'here we are going thru the list
Select Case index ' Here we are identifying which field we are populating
Case 1 '1st string(split)
MsgBox("1 " & arrList(0) & index) '1st string value left to SPLIT arrList(0).
Case 2 '2nd string(split)
MsgBox("2 " & arrList(1) & index) '2nd string value left to SPLIT arrList(1).
End Select
index += 1 'Here we adding one shift thru strings as we go
Next
I have a situation where I need to separate a statement pulled from SAP based on the word "Caller" The issue is that this word is used multiple times throughout the statement but I need it to only cut off the 1st sentence leading up to the 1st "Caller". Is there a way to have split separate these words out and then recombine everything split except the (0) instance.
Here is my code that I am using right now.
Description_Rough = session.findById("wnd[0]/usr/tabsTAB_GROUP_10/tabp10\TAB01/ssubSUB_GROUP_10:SAPLIQS0:7235/subCUSTOM_SCREEN:SAPLIQS0:7212/subSUBSCREEN_4:SAPLIQS0:7715/cntlTEXT/shellcont/shell").Text
Descrption_Final = Split(Description_Rough, "Caller")(1)
And the statement being pulled as description_rough is
08.08.2018 21:53:55 UTC "Name" (Numbers) Phone #########
17.07.2018 16:25:47 AAAAAA AAAAAA (AAAAAA)
Caller is patient using device. Caller reports that she has been using
current device for about 9 days and that the problems arose with the device. Caller reports that she monitors the device
each dose and does not recall what dose was in the device before it went to all red. Patient to return affected device to
Company; mail order pharmacy to replace to patient; Company to replace to
Pharmacy.
What I am looking for is everything beginning at "Caller is patient using device."
Simplest way to do it in my opinion
Sub Sample()
Dim Descrption_Final As String
Dim pos As Long
Descrption_Final = "17.07.2018 16:25:47 AAAAAA AAAAAA (AAAAAA) Caller is patient Blah Blah....."
pos = InStr(1, Descrption_Final, "caller", vbTextCompare)
If pos > 0 Then Debug.Print Mid(Descrption_Final, pos)
'~~> Output: Caller is patient Blah Blah.....
End Sub
And if you want everything before Caller is patient Blah Blah..... then use 0 instead of 1
Split(Description_Rough, "Caller")(0)
Example
Sub Sample()
Dim Descrption_Final As String
Dim pos As Long
Descrption_Final = "17.07.2018 16:25:47 AAAAAA AAAAAA (AAAAAA) Caller is patient Blah Blah....."
Debug.Print Split(Descrption_Final, "Caller")(0)
'~~> Output: 17.07.2018 16:25:47 AAAAAA AAAAAA (AAAAAA)
End Sub
This should work. It just starts from the second occurrence of "Caller" and pieces it all back together from there.
Description_Rough = "Caller is patient using device. Caller reports that..."
Dim temp As Variant
temp = Split(Description_Rough, "Caller")
Dim Description_Final As String
Dim i As Long
For i = LBound(temp) + 1 To UBound(temp)
Description_Final = Description_Final & "Caller" & temp(i)
Next i
Is there any way excel 2010 can lookup customer type by using meaningful part of customer name?
Example, The customer name is Littleton's Valley Market, but the list I am trying to look up the customer type the customer names are formatted little different such as <Littletons Valley MKT #2807 or/and Littleton Valley.
Some customer can be listed under multiple customer types, how can excel tell me what which customer and can I set excel to pull primary or secondary type?
Re #1. Fails on the leading < (if belongs!) and any other extraneous prefix but this may be rare or non-existent so:
=INDEX(G:G,MATCH(LEFT(A1,6)&"*",F:F,0))
or similar may catch enough to be useful. This looks at the first six characters but can be adjusted to suit, though unfortunately only once at a time. Assumes the mismatches are in ColumnA (eg A1 for the formula above) and that the correct names are in ColumnF with the required type in the corresponding row of ColumnG.
On a large scale Fuzzy Lookup may be helpful.
Since with a VBA tag Soundex matching and Levenshtein distance may be of interest.
Re #2 If secondary type is in ColumnH, again in matching row, then adjust G:G above to H:H.
pnuts gives a good answer re: Fuzzy Lookup, Soundex matching, etc. Quick and dirty way I've handled this before:
Function isNameLike(nameSearch As String, nameMatch As String) As Boolean
On Error GoTo ErrorHandler
If InStr(1, invalidChars(nameSearch), invalidChars(nameMatch), vbTextCompare) > 0 Then isNameLike = True
Exit Function
ErrorHandler:
isNameLike = False
End Function
Function invalidChars(strIn As String) As String
Dim i As Long
Dim sIn As String
Dim sOut As String
sOut = ""
On Error GoTo ErrorHandler
For i = 1 To Len(strIn)
sIn = Mid(strIn, i, 1)
If InStr(1, " 1234567890~`!##$%^&*()_-+={}|[]\:'<>?,./" & Chr(34), sIn, vbTextCompare) = 0 Then sOut = sOut & sIn
Next i
invalidChars = sOut
Exit Function
ErrorHandler:
invalidChars = strIn
End Function
Then I can call isNameLike from code, or use it as a formula in a worksheet. Note that you still have to supply the "significant" part of the customer name you're looking for.
I have code like this:
Dim MyACL As Variant
Dim Person As List
Redim MyACL(0)
Person("Detail1") = "Something1"
.
.
.
Person(Detailx") = "Somethingx"
ForAll name in names
ReDim Preserve MyAcl(Ubound(MyACL)+1)
Person("Name") = name
MyACL = ArrayAppend(MyACL,Person)
End ForAll
It throws error "Type Mismatch". Do you know, how to create an array of lists? Thank you.
This is a typical example of when you want to use a class instead, and create an array of that class. That class, in turn can contain a list (as well as other things). Can be very powerful!
Updated:
The benefit of using a class is that you can add business logic in the class, and it is very easy to extend it with more functionality later. Below is an example, based on the question above, but with additional functionality.
Class PersonObject
Public PersonAttribute List As String
Public NABdoc As NotesDocument
Public PersonName As String
Public Sub New(personname As String)
Dim nab as New NotesDatabase("Server/Domain","names.nsf")
Dim view as NotesView
'*** Get person document from Domino directory
Set view = nab.GetView("PeopleByFirstName")
Set me.NABdoc = view.GetDocumentByKey(personname)
'*** Set person name in object
me.PersonName = personname
'*** Set some values from person doc
me.PersonAttribute("Email") = GetValue("InternetAddress")
me.PersonAttribute("Phone") = GetValue("OfficePhone")
End Sub
Public Function GetValue(fieldname as String) as String
GetValue = me.NABdoc.GetItemValue(fieldname)(0)
End Function
Public Sub AddAttribute(attributename as String, value as string)
me.PersonAttribute(attributename) = value
End Sub
End Class
You can now very easily build you a list, using this class (and assuming that names is a list of unique names):
Dim person List As PersonObject
Dim personname As String
ForAll n in names
'*** Create person object based on name
person(n) = New PersonObject(n)
'*** Store additional info about this person
person.AddAttribute("Age","35")
End ForAll
Hopefully this gives you an idea of what you can do with classes.
You can also take a look at the following two blog entries about the basics of object oriented Lotusscript:
http://blog.texasswede.com/object-oriented-lotusscript-for-beginners-part-1/
http://blog.texasswede.com/object-oriented-lotusscript-for-beginners-part-2/
If you explicitely declare a variable as Array (as you do in your Redim Statement), then it can not be "reassigned" using arrayappend.
And it is NOT necessary to do it that way. just replace the line MyACL = ArrayAppend(MyACL,Person) with MyACL(Ubound(MyACL)) = Person
Take care: With that example code you will never fill MyACL(0) as the first Element filled is MyACL(1)
To begin filling the array with element 0 the code needs to be changed like this:
Dim max As Integer
max = 0
ForAll thisName In names
ReDim Preserve MyAcl(max)
Person("Name") = thisName
MyACL(max) = Person
max = max + 1
End ForAll
BUT: I don't know, if this is a good idea, as you can not access the "Detail1- Property" of Person directly.
Something like
detail = MyACL(1)("Detail1")
is not possible. You always have to have a temporary variable like this:
person = MyACL(1)
detail = person("Detail1")