Standardise telephone number format - excel

I have a column with 32 different phone formats that I need to consolidate into one format type: (###)###-####. The goal is to upload this formatted data into an existing db. I did find some formulas that help but these require helper cell.
I think some of the cells that contain less than 10 digits or more than ten digits will be manually fixed but no decision has been made yet. So, for now, I'll have some cells that have less than or more than the normal phone number (10 characters)
Here is a table of some of the original data and the result I need to see.
Original Data Result
*6.5033E+14 (650)329-670061133
*5.07127E+12 (507)127-2004904
*4.0809E+11 (408)089-787487
*9258254882 (925)825-4882
*6547621 (654)762-1
*310921278 (310)921-278
*415 6995743 (415)699-5743
*209-986-334 (209)986-334
*661-331-2792 (661)331-2792
*(831)383-8650 (1103) (313)838-6501103
*(415)488-9437 (517) (415)488-9437517
*(831)383-9452 (32) (831)383-945232
*(408)927-9482 (408)927-9482
*(000)408-7089 (000)408-7089
*b
*Oakland
Is it possible to create a macro so I won't have to use helper cells with various formulas? Also, I do have cells without a number so I would need a condition to ignore these cells as well.

Use this UDF.
Function TelFormat(s As String)
Dim sRp As String, n As Integer
s = Replace(s, "(", "")
s = Replace(s, ")", "")
s = Replace(s, "-", "")
s = Replace(s, " ", "")
n = Len(s) - 6
sRp = WorksheetFunction.Rept("#", n)
TelFormat = Format(s, "(000)-###-" & sRp)
End Function

Related

Split cell to fill two textboxes

I made a userform which contains two textboxes. When I click the button, the two textboxes are unified in a single cell.
Dim Dados As String, DadosLen As Integer
With Me
Dados = .caixanfnum.Text & Chr(10) & .caixanfdata.Text
DadosLen = Len(.caixanfnum.Text)
End With
With Sheets("-").Cells(linha, 4)
.Font.Bold = False
.WrapText = True
.Value = Dados
.Characters(1, DadosLen).Font.Bold = True
End With
I want to bring it back to the userform (I'm trying to make a search tool).
How do I split this cell to fill the two textboxes?
For your problem the split function should be the best solution, but you need a delimiter. The delimiter is the character at wich position the string (value of the cell) will be splitted.
splitted_text = Split(Sheets("-").Cells(linha, 4).Value, "your character")
This will return an array. You get the parts of the splitted string with splitted_text(0) and splitted_text(1)
Another way wich could work are the left, mid and right functions.
This will only work if the strings you are combining in the cell have a constant length.
first_string=Left(Sheets("-").Cells(linha, 4).Value, 5)
second_string=Right(Sheets("-").Cells(linha, 4).Value, 5)
middle_string=Mid(Sheets("-").Cells(linha, 4).Value, 5,5)
First string will return the 5 left chars of the string in the cell, second_string will return the 5 last chars in the string. The middle_string will give you five chars starting at the 5. position in the string, so it will give you char 5-9.
You could,
Use the Split function, or
Use the Left, Right, and Len Functions
1. Split
Dim TempSplit AS Variant
TempSplit = Split(Sheets("-").Cells(linha, 4), Chr(10))
.caixanfnum.Text = TempSplit(0)
.caixanfdata.Text = TempSplit(1)
This would be the most direct way to do this and is my preferred way.
If there are other instances of Chr(10) in your text box values however;
2. Using Left, Right and Len Functions (ft. Mid)
Something like;
.caixanfnum.Text = Left(Sheets("-").Cells(linha, 4), DadosLen)
.caixanfdata.Text = Right(Sheets("-").Cells(linha, 4), Len(Sheets("-").Cells(linha, 4)) - DadosLen)
Altenatively to the Right function you could use Mid instead:
Mid(Sheets("-").Cells(linha, 4), DadosLen + 2
Less preferred by me but will work.

How to extract the first instance of digits in a cell with a specified length in VBA?

I have the following Text sample:
Ins-Si_079_GM_SOC_US_VI SI_SOC_FY1920_US_FY19/20_A2554_Si Resp_2_May
I want to get the number 079, So what I need is the first instance of digits of length 3. There are certain times the 3 digits are at the end, but they usually found with the first 2 underscores. I only want the digits with length three (079) and not 19, 1920, or 2554 which are different lengths.
Sometimes it can look like this with no underscore:
1920 O-B CLI 353 Tar Traf
Or like this with the 3 digit number at the end:
Ins-Si_GM_SOC_US_VI SI_SOC_FY1920_US_FY19/20_A2554_Si Resp_2_079
There are also times where what I need is 2 digits but when it's 2 digits its always at the end like this:
FY1920-Or-OLV-B-45
How would I get what I need in all cases?
You can split the listed items and check for 3 digits via Like:
Function Get3Digits(s As String) As String
Dim tmp, elem
tmp = Split(Replace(Replace(s, "-", " "), "_", " "), " ")
For Each elem In tmp
If elem Like "###" Then Get3Digits = elem: Exit Function
Next
If Get3Digits = vbNullString Then Get3Digits = IIf(Right(s, 2) Like "##", Right(s, 2), "")
End Function
Edited due to comment:
I would execute a 2 digit search when there are no 3 didget numbers before the end part and the last 2 digits are 2. if 3 digits are fount at end then get 3 but if not then get 2. there are times when last is a number but only one number. I would only want to get last if there are 2 or 3 numbers. The - would not be relevant to the 2 digets. if nothing is found that is desired then would return " ".
If VBA is not a must you could try:
=TEXT(INDEX(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"_"," "),"-"," ")," ","</s><s>")&"</s></t>","//s[.*0=0][string-length()=3 or (position()=last() and string-length()=2)]"),1),"000")
It worked for your sample data.
Edit: Some explaination.
SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"_"," "),"-"," ")," ","</s><s>") - The key part to transform all three potential delimiters (hyphen, underscore and space) to valid XML node end- and startconstruct.
The above concatenated using ampersand into a valid XML construct (adding a parent node <t>).
FILTERXML can be used to now 'split' the string into an array.
//s[.*0=0][string-length()=3 or last() and string-length()=2] - The 2nd parameter of FILTERXML which should be valid XPATH syntax. It reads:
//s 'Select all <s> nodes with
following conditions:
[.*0=0] 'Check if an <s> node times zero
returns zero (to check if a node
is numeric. '
[string-length()=3 or (position()=last() and string-length()=2)] 'Check if a node is 3 characters
long OR if it's the last node and
only 2 characters long.
INDEX(.....,1) - I mentioned in the comments that usually this is not needed, but since ExcelO365 might spill the returned array, we may as well implemented to prevent spilling errors for those who use the newest Excel version. Now we just retrieving the very first element of whatever array FILTERXML returns.
TEXT(....,"000") - Excel will try delete leading zeros of a numeric value so we use TEXT() to turn it into a string value of three digits.
Now, if no element can be found, this will return an error however a simple IFERROR could fix this.
Try this function, please:
Function ExtractThreeDigitsNumber(x As String) As String
Dim El As Variant, arr As Variant, strFound As String
If InStr(x, "_") > 0 Then
arr = Split(x, "_")
Elseif InStr(x, "-") > 0 Then
arr = Split(x, "-")
Else
arr = Split(x, " ")
End If
For Each El In arr
If IsNumeric(El) And Len(El) = 3 Then strFound = El: Exit For
Next
If strFound = "" Then
If IsNumeric(Right(x, 2)) Then ExtractThreeDigitsNumber = Right(x, 2)
Else
ExtractThreeDigitsNumber = strFound
End If
End Function
It can be called in this way:
Sub testExtractThreDig()
Dim x As String
x = "Ins-Si_079_GM_SOC_US_VI SI_SOC_FY1920_US_FY19/20_A2554_Si Resp_2_May"
Debug.Print ExtractThreeDigitsNumber(x)
End Sub

VBA: Add Carriage Return + Line Feed at the start of Uppercase phrase

I have cells that contain various information.
In these cells, there are multiple Uppercase phrases.
I would like to be able to split the contents of the cell by adding the CHAR(13) + CHAR(10) Carriage return - linefeed combination
to the start of each new Uppercase phrase.
The only consistency is that the multiple Uppercase phrases begin after a period (.) and before open parenthesis "("
Example:
- Add CRLF to start of PERSUADER
- Add CRLF to start of RIVER JEWEL
- Add CRLF to start of TAHITIAN DANCER
- Add CRLF to start of AMBLEVE
- Add CRLF to start of GINA'S HOPE
NOTE:
There are multiple periods (.) in the text.
I have highlighted the text in red for a visual purpose only (normal text/font during import).
I am OK with either formula, UDF or VBA sub.
TEXT
PERSUADER (1) won by a margin first up at Kyneton. Bit of authority about her performance there and with the stable finding form it's easy to see her going right on with that. Ran really well when placed at Caulfield second-up last prep and that rates well against these. RIVER JEWEL (2) has been racing well at big odds. I have to like the form lines that she brings back in class now. Shapes as a key danger. TAHITIAN DANCER (5) will run well. She was okay without a lot of room at Flemington last time. AMBLEVE (13) is winning and can measure up while GINA'S HOPE (11) wasn't too far from River Jewel at Flemington and ties in as a hope off that form line.
I was able to extract with this function - but not able to manipulate the data in the cell
This is my code so far:
Function UpperCaseWords(ByVal S As String) As String
Dim X As Long, Words() As String
Const OkayPunctuation As String = ",."";:'&,-?!"
For X = 1 To Len(OkayPunctuation)
S = Replace(S, Mid(OkayPunctuation, X, 1), " ")
Next
Words = Split(WorksheetFunction.Trim(S))
For X = 0 To UBound(Words)
If Words(X) Like "*[!A-Z]*" Then Words(X) = ""
Next
UpperCaseWords = Trim(Join(Words))
End Function
Your description is not the same as your examples.
None of your examples start after a dot.
Most start after a dot-space except
PERSUADER starts at the start of the string
GINA'S HOPE starts after a space
I incorporated those rules into a regular expression, but, since your upper case words can include punctuation, for brevity I just looked for
- words that excluded lower case letters and digits
- words at least three characters long
If that is not sufficient in your real data, the regex can easily be made more specific:
Option Explicit
Function upperCaseWords(S As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = True
.MultiLine = True
.Pattern = "^|\s(\b[^a-z0-9]+\b\s*\()"
upperCaseWords = .Replace(S, vbCrLf & "$1")
End With
End Function
as per your wording
The only consistency is that the multiple Uppercase phrases begin
after a period (.) and before open parenthesis "("
this should do:
Function UpperCaseWords(ByVal s As String) As String
Dim w As Variant
Dim s1 As String
For Each w In Split(s, ". ")
If InStr(w, "(") Then w = Chr(13) + Chr(10) & w
s1 = s1 & w
Next
UpperCaseWords = s1
End Function
Since the OP accepted the formula solution, and here is a formula answer .
Assume data put in A1
In B1, enter formula and copied across until blank :
=TRIM(RIGHT(SUBSTITUTE(TRIM(MID(SUBSTITUTE(SUBSTITUTE(" (. "&$A1," while ",". ")," (",REPT(" ",700)),COLUMN(A1)*700,700))&" ",". ",REPT(" ",300)),300))

How do I perform a XOR calculation of two binary numbers in excel 2007

I wanted to perform a XOR calculation of two Binary numbers for example: on Sheet 1
Range A1 = 10101010
Range A2 = 11100010
Now I need to perform XOR of A1, A2 result in A3. I tried different formula's two perform XOR calculations like: A1^A2, (BITXOR (A1, A2)) but unfortunately it didn't worked I think because I am using excel 2007 "XOR" doesn't support.
I'm expecting a result of 1001000.
First, you should note that Excel pre-Excel2013 has no bitwise operators or functions built-in (Excel's OR() function is logical even if the operands are numeric). Excel 2013 finally adds this glaringly missing functionality.
Using VBA
The simplest way is to create a User Defined Function that does it. Formulae can work if you are prepared for either a decimal output, or helper columns, or a very repetitive Concatenate formula but VBA gets around these limitations - I recommend it if you are able to have code in the workbook.
Decimal Input, Decimal Output
The below examples just expose the built-in bitwise operators to use as functions in Excel formulae. I assume an integral type, although you could change it to accept decimals etc.
You can convert your string binary numbers (e.g. "1010") to decimals (10, for the previous example) using the BIN2DEC() function built-in to Excel, although this only handles 9 bits + sign bit, alternatively you can use an array formula to convert it for you (see my section on "Using Formulas" below).
Public Function BITWISE_OR(operand1, operand2)
BITWISE_OR = CLng(operand1) Or CLng(operand2)
End Function
Public Function BITWISE_AND(operand1, operand2)
BITWISE_AND = CLng(operand1) And CLng(operand2)
End Function
Public Function BITWISE_XOR(operand1, operand2)
BITWISE_XOR = CLng(operand1) Xor CLng(operand2)
End Function
Converting the numeric results back to binary strings is pretty annoying with formulas - if you need more than the range covered by DEC2BIN() (a paltry -512 to +511) function built in to Excel then I would suggest either using VBA (see below), or building up your binary string bit by bit using columns or rows (see my Using Formulas section below).
Binary string input, Binary string output
The below essentially iterates through a string setting each bit in turn based on the corresponding bits in the input strings. It performs the bit changes on the string in-place using Mid$ statement. Bit strings can be arbitrary length.
The below looks complicated but really it is the same basic stuff repeated 3 times for each of And, Or and XOr.
'str1, str2: the two bit strings. They can be different lengths.
'significantDigitsAreLeft: optional parameter to dictate how different length strings should be padded. Default = True.
Public Function Bitstr_AND(str1 As String, str2 As String, Optional significantDigitsAreLeft As Boolean = True)
Dim maxLen As Long, resStr As String, i As Long
If Len(str1) > Len(str2) Then maxLen = Len(str1) Else maxLen = Len(str2) 'get max length of the two strings
str1 = getPaddedString(str1, maxLen, significantDigitsAreLeft) 'pad left or right to the desired length
str2 = getPaddedString(str2, maxLen, significantDigitsAreLeft) 'pad left or right to the desired length
resStr = String$(maxLen, "0") 'prepare the result string into memory (Mid$ can operate without creating a new string, for performance)
For i = 1 To maxLen
If Mid$(str1, i, 1) = "1" And Mid$(str2, i, 1) = "1" Then
Mid$(resStr, i, 1) = "1" 'in-place overwrite of the existing "0" with "1"
End If
Next i
Bitstr_AND = resStr
End Function
'For explanatory comments, see Bitstr_AND
Public Function Bitstr_OR(str1 As String, str2 As String, Optional significantDigitsAreLeft As Boolean = True)
Dim maxLen As Long
Dim resStr As String
Dim i As Long
If Len(str1) > Len(str2) Then maxLen = Len(str1) Else maxLen = Len(str2)
str1 = getPaddedString(str1, maxLen, significantDigitsAreLeft)
str2 = getPaddedString(str2, maxLen, significantDigitsAreLeft)
resStr = String$(maxLen, "0")
For i = 1 To maxLen
If Mid$(str1, i, 1) = "1" Or Mid$(str2, i, 1) = "1" Then
Mid$(resStr, i, 1) = "1"
End If
Next i
Bitstr_OR = resStr
End Function
'For explanatory comments, see Bitstr_AND
Public Function Bitstr_XOR(str1 As String, str2 As String, Optional significantDigitsAreLeft As Boolean = True)
Dim maxLen As Long
Dim resStr As String
Dim i As Long
If Len(str1) > Len(str2) Then maxLen = Len(str1) Else maxLen = Len(str2)
str1 = getPaddedString(str1, maxLen, significantDigitsAreLeft)
str2 = getPaddedString(str2, maxLen, significantDigitsAreLeft)
resStr = String$(maxLen, "0")
For i = 1 To maxLen
If Mid$(str1, i, 1) = "1" Then
If Not Mid$(str2, i, 1) = "1" Then
Mid$(resStr, i, 1) = "1"
End If
ElseIf Mid$(str2, i, 1) = "1" Then 'Save an If check by assuming input string contains only "0" or "1"
Mid$(resStr, i, 1) = "1"
End If
Next i
Bitstr_XOR = resStr
End Function
'Helper to pad string
Private Function getPaddedString(str As String, length As Long, padLeft As Boolean) As String
If Len(str) < length Then
If padLeft Then
getPaddedString = String$(length - Len(str), "0") & str
Else
getPaddedString = str & String$(length - Len(str), "0")
End If
Else
getPaddedString = str
End If
End Function
Using Formulas
You can do an XOR operation using Text functions or Sumproduct. This may be more appropriate if you do not want to use VBA but formulas are painful to ensure they covers all situations, like negatives or different length binary strings. I refer you to the superb blog post http://www.excelhero.com/blog/2010/01/5-and-3-is-1.html for examples using Sumproduct, and http://chandoo.org/wp/2011/07/29/bitwise-operations-in-excel/ for examples using Text functions.
I cooked up my own formulae that handles certain cases and I explain them below to guide you.
Binary string Input, Decimal Output
In the below, A2 and B2 refer to the two binary numbers in up to 32-bits string form. The strings can be variable length, as the formula will pad with 0's to the necessary length. It should be obvious how to increase it to more bits. They must be entered using Ctrl+Shift+Enter.
The most significant bit is on the left. To make it least significant bit on the left, you can remove the little subtraction in the powers of 2 part, and make it pad to the right.
Bitwise And:
=SUM((((MID(REPT("0",32-LEN($A$2))&$A$2,ROW($1:$32),1)="1")+(MID(REPT("0",32-LEN($B$2))&$B$2,ROW($1:$32),1)="1"))=2)*(2^(32-ROW($1:$32))))
Bitwise Or:
=SUM((((MID(REPT("0",32-LEN($A$2))&$A$2,ROW($1:$32),1)="1")+(MID(REPT("0",32-LEN($B$2))&$B$2,ROW($1:$32),1)="1"))>0)*(2^(32-ROW($1:$32))))
Bitwise Xor:
=SUM((((MID(REPT("0",32-LEN($A$2))&$A$2,ROW($1:$32),1)="1")+(MID(REPT("0",32-LEN($B$2))&$B$2,ROW($1:$32),1)="1"))=1)*(2^(32-ROW($1:$32))))
Binary string input, Binary string Output
A single cell solution would be arduous because there is no array concatenation formula in Excel. You could do it using the CONCATENATE function glueing together each bits, with each bit being the result of an If comparing each binary string returning 1 or 0 as appropriate. As I said, though easy (just build it up like =IF(Mid(A1,1,1) = "1",...), this would be boring so I personally won't do it for you ;)
Alternatively, you could do it more simply using columns or rows to build up the string, like:
If A1 and B1 have your binary strings, then in C1 put (for AND, or for OR change the =2 at the end to >0 and for XOR change it to =1):
=IF((MID($A1,1,1)="1")+(MID($B1,1,1)="1"))=2,"1","0")
Then in D1 put:
=C1 & IF((MID($A1,COLUMN()-COLUMN($C1),1)="1")+(MID($B1,COLUMN()-COLUMN($C1),1)="1"))=2,"1","0")
Then drag this across as many columns as bits

Combining formulas

I have this formula in a table which basically collects data from two columns and combines them. Now, I'm looking to combine this formula with a REPLACE formula that basically takes these characters æ,ø,å and replaces them with a,o,a.
Here's the formula:
=LOWER(LEFT(tableFaste[[#This Row];[Fornavn:]])&tableFaste[[#This Row];[Etternavn:]])
Sorry, don't know of a Formula way to remove any of a list of characters from a string. You might have to revert to vba for this. Here's a user defined function to do it. Your formula will become
=DeleteChars([#UserName],{"æ","ø","å";"a","o","a"})
To replace the characters use {"æ","ø","å";"a","o","a"} where the list up to the ; is the old characters, after the ; the new. You can make the list as long as you need, just make sure the lists are the same length.
To Delete the characters replace use {"æ","ø","å"} an array list of characters you want to remove
UDF code:
Function DeleteChars(r1 As Range, ParamArray c() As Variant) As Variant
Dim i As Long
Dim s As String
s = r1
If UBound(c(0), 1) = 1 Then
For i = LBound(c(0), 2) To UBound(c(0), 2)
s = Replace(s, c(0)(1, i), "")
Next
Else
For i = LBound(c(0), 2) To UBound(c(0), 2)
s = Replace(s, c(0)(1, i), c(0)(2, i))
Next
End If
DeleteChars = s
End Function
You can use SUBSTITUTE
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(LOWER(LEFT(tableFaste[[#This Row];[Fornavn:]])&tableFaste[[#This Row];[Etternavn:]]),"æ","a"),"ø","o"),"å","a")

Resources