I need some help with a formula to rearrange names. I've found lots of formulas that work in some cases, but none that can handle all of the cases I encounter.
Briefly, here is the list of names, and the desired output:
Original names Desired Output
John, James J James John
Junior, Lake Lake Junior
Mitchel, Fields M Fields Mitchel
Rothschild Jr., Michael K Michael Rotschild
Sally, Sue L Sue Sally
Rinkel, Michael Michael Rinkel
Rivel, Nicholas L Nicholas Rivel
Hurwitz Sr., Susan Susan Hurwitz
The formula I have so far is: =TRIM(PROPER(TRIM(IF(ISERROR(FIND(",",A1,1)),A1,MID(A1,FIND(",",A1,1)+1,IF(ISERROR(FIND(" ",A1,FIND(",",A1,1)+2)),LEN(A1),FIND(" ",A1,FIND(",",A1,1)+2))-FIND(",",A1,1))))&" "&LEFT(A1,IF(ISERROR(FIND(",",A1,1)),LEN(A1),FIND(",",A1,1)-1))))
Its cobbled together from some other formulas I have found, and eliminates middle initials if they are present, but not the Sr. or Jr.'s if they are present.
There are so many nuances to parsing names that just as soon as you think you have covered all possibilities, there are new ones coming up. If you keep a User Defined Formula (aka UDF), you can quickly add new coding processes to meet new problems.
Public Function fcn_First_Last_Name(sNAM As String)
Dim sTMP As String, v As Long, vDELs As Variant, vNAMs As Variant
sTMP = Application.Trim(sNAM)
vDELs = Array(" Jr.", " Sr.", " III", " II")
sTMP = Replace(sTMP, Chr(160), Chr(32))
For v = LBound(vDELs) To UBound(vDELs)
sTMP = Replace(sTMP, vDELs(v), vbNullString, compare:=vbTextCompare)
Next v
If Asc(Mid(sTMP, Len(sTMP) - 1, 1)) = 32 Then sTMP = Trim(Left(sTMP, Len(sTMP) - 1))
vNAMs = Split(sTMP, Chr(44))
If CBool(UBound(vNAMs)) Then
fcn_First_Last_Name = vNAMs(UBound(vNAMs)) & Chr(32) & vNAMs(LBound(vNAMs))
Else
fcn_First_Last_Name = vNAMs(UBound(vNAMs))
End If
End Function
That should get you started. It should also prove to be a good learning experience as you add new routines to cover new difficulties.
Once you have that in a VBA code module sheet, use it just like any other worksheet formula. Example:
Another possibility, but very clunky:
=MID(A2,FIND(", ",A2,1)+2,IFERROR((FIND(" ",A2,FIND(", ",A2,1)+2)-4)-FIND(", ",A2,1)+2,LEN(A2)))&" "&IFERROR(LEFT(A2,FIND(" ",LEFT(A2,FIND(", ",A2,1)-1))-1),LEFT(A2,FIND(", ",A2,1)-1))
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.
At work I am required to reformat incorrect Addresses on a weekly basis from records in our Salesforce instance. We gather the incorrectly formatted addresses using a Report and export them to an Excel file. My job is simply to manipulate the data in the file to format them properly then reinsert them into the database.
Typically the addresses are formatted as so:
5 Sesame Street, Anytown, Anyplace
Separating these can be done easily by hand, but I typically have to work with hundreds of addresses at a time, and using default excel formulas tends to require lots of wrangling multiple cells at once to break it up into fragments.
Thus I wrote a custom formula to run through the cell and return a specific fragment of the string based on the "Comma Number" given. So if I give a Comma Number of 1, I would get "5 Sesame Street", 2 would get me "Anytown", etc.
Here is my code so far:
Public Function fragmentAddress(address As String, numberofcommas As Integer) As String
seen = 1
lastComma = -1
Dim x As Long
Dim frag As Long
For x = 0 To Len(address)
If Mid(address, x, 1) = "," & numberofcommas = seen Then
Exit For
ElseIf Mid(address, x, 1) = "," & numberofcommas <> seen Then
seen = seen + 1
lastComma = x
End If
Next
frag = Mid(address, lastComma + 1, seen - lastComma)
fragmentAddress = frag
I have not implemented the ability to handle the final value yet, but it does not give me any outputs, only outputting a "#VALUE!" error when I attempt to give it the input
=fragmentAddress("3 Ashley Close, Charlton Kings",1)
I have some experience with programming, but this is my first time writing anything in VBA.
Any help would be appreciated, thank you.
Not exactly sure what your question is, but this is simpler:
Public Function GetAddressFragment(ByVal Address As String, ByVal Index As Integer) As String
Dim addr() As String
addr = Split(Address, ",")
On Error Resume Next
GetAddressFragment = Trim(addr(Index - 1))
End Function
Okay I'll try to explain this the best way possible
- I am parsing .txt files which get imported into excel
- The .txt files which are parsed all have static fields (sometimes)
- In the future these fields could change and may not be static therefore the below code would parse pretty sloppy stuff
Questions:
1. Assuming in the future that these string values can change (ie "CUSTOMER NAME:" changes to DISTRIBUTOR NAME:)
a. Is there are way I can manipulate the data to where I only have to establish the name of the strings and skip having to establish the location of the strings within the text based on character length? (ie without using Mid(text, act + 6, 9))
If so, how would I go about doing this? Some lines within the text file have 1, 2 or three fields (ie SOME INDICATOR:,NO STATUS:,AUTO RENEW:.. has three field values, while the first line has one, and the second two. I am guessing one way to do this would be to establish the name of the strings so that every field between said string and the next string would be the string fields value ie:
ACCOUNT OPEN:(string 1) 05/10/15(string 1 value) ACT TYPE:(string 2) PREMIUM (string value 2)
In a nutshell I am trying to find a way that I can making this parser 'intelligent' so to speak. While its no big deal using the below method for the first part of a customers record, in reality each record has additional screens (mainframe). There are also additional screens pertaining to other things such as inventory, order numbers, etc.. So you could see how this could become a large and tedious undertaking. I don't mind spending a few months to map each field, it is just more work that I think is necessary, so any input would be greatly appreciated on how I can do this.
Also my below code does not work completely. It correctly imports the first record of text file but repeats that exact record for the remainder of rows in excel ( ie account: ABCDEF12 is repeated for 100 rows in excel rather than going down the list of records. Each new record starts 20 lines down from the previous). I am assuming that I have my loop structure wrong? Any thoughts? Any thoughts on how I can make the autofit portion of the below code more efficient? Currently it adds a lot more time to how long my code takes to parse, trim, clean and autofit, and ideas on how to shorten this?
Dim myFile As String
Dim text As String
Dim textline As String
Dim cstAct as integer
Dim actOpe as integer
Dim cusNam as integer
Dim act as integer
Dim reg as integer
myFile = "put file patch to text file here"
myFile = Application.GetOpenFilename()
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
cusAct = InStr(text, "ACCOUNT ")
actOpe = InStr(text, "ACCOUNT OPEN:")
reg = InStr(text, "REGION:")
cusNam = InStr(text, "CUSTOMER NAME:")
For i = 2 To ThisWorkbook.Worksheets("b2").Range("a65536").End(xlUp).Row
ThisWorkbook.Worksheets("name").Range("a" & i).Value = Mid(text, act + 6, 9)
ThisWorkbook.Worksheets("name").Range("b" & i).Value = Mid(text, cstAct + 6, 9)
ThisWorkbook.Worksheets("name").Range("c" & i).Value = Mid(text, actOpe + 13, 27)
ThisWorkbook.Worksheets("name").Range("d" & i).Value = Mid(text, cusNam + 20, 19)
next i
'here I format and autofit the cells
For x = 2 To ThisWorkbook.Worksheets("b2").Range("a65536").End(xlUp).Row
Range("a" & x).Value = Application.WorksheetFunction.Clean(trim(Range("a" & x)))
Range("b" & x).Value = Application.WorksheetFunction.Clean(trim(Range("b" & x)))
Range("c" & x).Value = Application.WorksheetFunction.Clean(trim(Range("c" & x)))
'etc etc
next x
'Text file which is parsed and then imported into excel
ACCOUNT ABCDEF12
ACCOUNT OPEN: 05/10/15 ACT TYPE: PREMIUM
CUSTOMER NAME: JOHN B. SMITH CSA REP: 154983
CUSTOMER ADDRESS: 123 SOMEWHERE DRIVE SOMETHING HERE:
LAST ORDER: 06/24/2011 COUNTRY CODE: UNITED STATES
INVOICE #: 123456789 STATE CODE: CALIFORNIA
LAST MAINTENANCE: 01/02/15 COUNTY CODE: UNCODED
SOME INDICATOR: NO COMPLAINTS: NO IPM IND: DATAPREP/PERF4
SOME INDICATOR: NO STATUS: NONE AUTO RENEW: YES
SOMETHING HERE: NO
SOMETHING HERE: ABC IND:
SOMETHING HERE: 2 ABC ASSET NO: T
.......REMAINDER OF TXT FILE REPEATS...JUST DIFFERENT RECORDS....
ACCOUNT ZXYFDG13
ACCOUNT OPEN: 05/10/15 ACT TYPE: PREMIUM
CUSTOMER NAME: JANE B. SMITH CSA REP: 154983
CUSTOMER ADDRESS: 123 SOMEWHERE DRIVE SOMETHING HERE:
LAST ORDER: 06/24/2011 COUNTRY CODE: UNITED STATES
INVOICE #: 123456789 STATE CODE: CALIFORNIA
LAST MAINTENANCE: 01/02/15 COUNTY CODE: UNCODED
SOME INDICATOR: NO COMPLAINTS: NO IPM IND: DATAPREP/PERF4
SOME INDICATOR: NO STATUS: NONE AUTO RENEW: YES
SOMETHING HERE: NO
SOMETHING HERE: ABC IND: NO
SOMETHING HERE: 2 REGION: NE
.....Records continue Indefinitely.........
I've been wondering if there is a more efficient, and probably neater way of performing an amateur function that I've just coded:
Public Function JanApr_prices()
'catalogue price changes
With ThisWorkbook.Worksheets("catalogue").ListObjects(1)
.DataBodyRange(44, 4).Value = 4.8 'Product A
.DataBodyRange(52, 4).Value = 4.5 'Product B
.DataBodyRange(77, 4).Value = 6 'Product C
.DataBodyRange(79, 4).Value = 9 'Product D
End With
End function
This basically changes prices for a set number of months when I'm doing some accounting. While it works, it definitely has its drawbacks because if I ever changed the relative position of the entries on the table, the price changes would probably go to the wrong place. So I'm in need of another idea, perhaps using a combination of .cells and match? I like to do things neatly and all the solutions that I've thought up so far are rather ponderous. Any suggestions would be greatly appreciated!
Feel free to edit the post title, I really did not know how to describe my problem!
The following code is not complete and will have to be adjusted to your needs. It is merely ment to show you the basic concept of the solution I propose.
Public Function JanApr_prices()
Dim vArr As Variant
Dim lCount As Long
vArr = ThisWorkbook.Worksheets("catalogue").ListObjects(1).Range.Value2
For lCount = LBound(vArr) To UBound(vArr)
Select Case vArr(lCount, 1)
Case "Produkt A"
vArr(lCount, 2) = 4.8
Case "Produkt B"
vArr(lCount, 2) = 4.5
Case "Produkt C"
vArr(lCount, 2) = 6
Case "Produkt D"
vArr(lCount, 2) = 9
End Select
Next lCount
ThisWorkbook.Worksheets("catalogue").ListObjects(1).Range.Value2 = vArr
End Function
The above code was taken from this website and slightly adapted:
https://fastexcel.wordpress.com/2011/05/25/writing-efficient-vba-udfs-part-1/
While I do not like to copy code from the web, StackOverflow prefers to be self-contained without the need to external references. So, there you go.
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.