One of my cell column in Excel looks like this:
00071331
000062KV
00008M01
00009R22
001N5350
12345678
00123456
I want to remove all the leading zeros. The output should look like this:
71331
62KV
8M01
9R22
1N5350
12345678
123456
I have tried using Flash fill in excel but it is not picking up the pattern.
Use MID,AGGREGATE:
=MID(A1,AGGREGATE(15,7,ROW($1:$8)/(MID(A1,ROW($1:$8),1)<>"0"),1),8)
Because you tagged VBA, try:
Sub NoZero()
Dim r As Range, v As String
For Each r In Range("A:A")
v = r.Text
If v = "" Then Exit Sub
While Left(v, 1) = "0"
v = Mid(v, 2, Len(v))
Wend
r.Value = v
Next r
End Sub
This will perform the conversion "in-place", without the need of a "helper column".
I think in your case you could use:
=MID(A1,FIND(LEFT(SUBSTITUTE(A1,"0",""),1),A1),8)
Or an array formula like:
=MID(A1,MATCH(TRUE,MID(A1,ROW($1:$8),1)<>"0",0),8)
Or if you don't want to enter it as array formula:
=MID(A1,MATCH(TRUE,INDEX(MID(A1,ROW($1:$8),1)<>"0",),0),8)
Same as #Gary's Student, but with minor changes: working not with column A, but with the current selection; in a string of the form 0000, not all zeros are removed, but only leading ones, etc.
Sub NoZeroAnywhere()
Dim r As Range, v As String
Rem Work with all selected cells
If TypeName(Selection) <> "Range" Then Exit Sub
For Each r In Selection.Cells
v = r.Text
If v <> "" Then ' Don't break loop on empty cell
Rem Condition Len(v)>1 prevent remove all zeros, 0000 will be 0, not empty string
While Len(v) > 1 And Left(v, 1) = "0"
v = Right(v, Len(v) - 1)
Wend
r.Value = v
End If
Next r
End Sub
You could also do it as UDF using regex:
Function RemoveLeadingZeroes(stringOne As String) As String
Dim regexOne As Object
Set regexOne = New RegExp
regexOne.Pattern = "^0*"
RemoveLeadingZeroes = regexOne.Replace(stringOne, "")
End Function
Note: Have to enable Tools>References>Microsoft VBScript Regular Expressions in VBA editor.
Related
I am trying to use vba to read client feedback and reference it to a set of keywords mapped to categories. However the problem I am having is that on occasion, clients use special characters such as “ -^<* ‘ in their comments and this is breaking my code as soon as it hit such a string.
How can I make my code ignore these special characters and keep moving down the rows to search for criteria? Thanks in advance
First place the data to be "cleaned-up" in column A, then run:
Sub Kleanup()
Dim A As Range, aa As Range, L As Long, i As Long
Dim CH As String, temp As String
Set A = Range("A:A")
For Each aa In Intersect(A, ActiveSheet.UsedRange)
If aa <> "" Then
L = Len(aa)
temp = ""
For i = 1 To L
CH = Mid(aa, i, 1)
If CH Like "[A-Za-z0-9]" Then
temp = temp & CH
End If
Next i
aa.Value = temp
End If
Next aa
End Sub
It will remove all characters except 0 through 9 and upper case letters and lower case letters.
Quick question, if I want to delete everything after the second occurrence of a number:
i.e -
I have:
1105 Bracket Ave. Suite 531 Touche
5201 Used St. 1351 Bored Today
I want:
1105 Bracket Ave. Suite 531
5201 Used St. 1351
is there a simple formula or VBA I would use for this?
Here is a UDF using VBA's regular expression engine to remove all after the second integer.
Option Explicit
Function FirstTwoNumbers(S As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "(\d+\D+\d+).*"
FirstTwoNumbers = .Replace(S, "$1")
End With
End Function
If there is only a single integer, it will return the entire string.
If the numbers might be decimal numbers, will need to modify .Pattern
And here is another UDF using only native VBA methods:
Function FirstTwo(S As String) As String
Dim V
Dim tS As String
Dim I As Long, numNumbers As Long
V = Split(S)
Do Until numNumbers = 2
tS = tS & Space(1) & V(I)
I = I + 1
If IsNumeric(V(I - 1)) Then numNumbers = numNumbers + 1
Loop
FirstTwo = Mid(tS, 2)
End Function
and finally, a formula with no particular assumptions:
=LEFT(A1,FIND(CHAR(1),SUBSTITUTE(A1," ",CHAR(1),LOOKUP(2,1/ISNUMBER(-TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",99)),seq_99,99))),seq))))
seq and seq99 are Named Formulas Formula ► Define Name
seq Refers to: =ROW(INDEX($1:$255,1,1):INDEX($1:$255,255,1))
seq_99 Refers to: =IF(ROW(INDEX($1:$255,1,1):INDEX($1:$255,255,1))=1,1,(ROW(INDEX($1:$255,1,1):INDEX($1:$255,255,1))-1)*99)
This solution is with these assumptions:-
First occurrence of a number will not have a length > 10
There will atleast a distance of 10 or 10 alphabets including spaces between first and second number
There will always be a 'space' existing after second number
There will always be a second number present in the string
Try this:-
=TRIM(MID(A1,1,FIND(" ",A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789",MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))+10)))))
Here is a VBA approach, amend range to suit. It puts the answer in the adjacent column
Sub x()
Dim oMatches As Object, r As Range
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\d+"
For Each r In Range("A1:A5")
If .Test(r) Then
Set oMatches = .Execute(r)
If oMatches.Count > 1 Then
r.Offset(, 1).Value = Left(r, oMatches(1).firstindex + oMatches(1).Length)
Else
r.Offset(, 1).Value = r.Value
End If
Else
r.Offset(, 1).Value = r.Value
End If
Next r
End With
End Sub
You can use the following formula,if A1 is your string,in B1 write:
=LEFT(A1,MAX(IFERROR(ISNUMBER(VALUE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)))*ROW(INDIRECT("1:"&LEN(A1))),0)))
press Ctrl+Shift+Enter at the same time Array Formula
This will read the length of the string and return the Maximum place of numbers (last number in the string) and return the Left() string till this number
I have a columns of strings as follows. How can I put the symbol '<' in between the characters ?
'ABCDE'
'BCG'
'ABCD'
The expected output should be:
A<B<C<D<E
B<C<G
A<B<C<D
=concatenate(left(A1,1),"<",mid(A1,2,1),"<",mid(A1,3,1),(if(len(A1)>3,"<"&mid(A1,4,1)&if(len(A1)>4,"<"&mid(A1,5,1),""),"")))
Will do what you want for values up to 5 letters, and as few as 3 letters. Otherwise you can change it.
Basically it adds a "<" between the first 3 letters and then checks whether the string is longer than 3 letters and if so, adds more "<" characters. If this needs to be more dynamic it's far easier in vba.
A manual, one-off, no-VBA approach would be:
use the Text to Columns tool with Fixed Width and place the markers after each character.
then use a formula like this to append values and separator
The formula could look like this if your values are in row 1
=A1&IF(LEN(B1)>0,">"&B1,"")&IF(LEN(C1)>0,">"&C1,"")&IF(LEN(D1)>0,">"&D1,"")&IF(LEN(E1)>0,">"&E1,"")
Adjust formula to suit the maximum number of characters in a cell.
Such things are not for formulas...
As you tag question as Excel-VBA too, so:
'''''''
Private Sub sb_Test_fp_AddSym()
Debug.Print fp_AddSym("abncd", "<")
End Sub
Public Function fp_AddSym(pStr$, pSym$) As String
Dim i&, j&, iLB&, iUBs&, iUBt&
Dim tSrc() As Byte, tTgt() As Byte, tSym As Byte
tSrc = pStr
tSym = Asc(pSym)
iLB = LBound(tSrc)
iUBs = UBound(tSrc)
iUBt = iUBs * 2 + 3
ReDim tTgt(iLB To iUBt)
For i = iLB To iUBs Step 2
j = i * 2
tTgt(j) = tSrc(i)
tTgt(j + 1) = tSrc(i + 1)
tTgt(j + 2) = tSym
tTgt(j + 3) = 0
Next
ReDim Preserve tTgt(iLB To (iUBt - 4))
Debug.Print tTgt
Stop
fp_AddSym = tTgt
End Function
'''
This worked for me:
Sub SymbolInsert()
Dim cl As Range, temp As String
For Each cl In Range("A1:A3") '~~~> Define your range here
For i = 1 To Len(cl)
temp = temp & Mid(cl, i, 1) & "<"
Next i
cl = IIf(VBA.Right$(temp, 1) = "<", VBA.Left$(temp, Len(temp) - 1), temp)
temp = vbNullString
Next cl
End Sub
It can probably be done with Excel formula for any length, but here is the shortest VBA solution
For Each c In Range("A:A").SpecialCells(xlCellTypeConstants)
c.Value2 = Replace( Left$( StrConv( c, vbUnicode), Len(c) * 2 - 1), vbNullChar, "<")
Next
I want to create either a macro or a UDF that can find cells in an excel worksheet that contains the following:
POxxx
PO xxxxxxx
PO# xxxxx
PO#xxxx
(With x being numbers)
The string could be at the start or the middle of cells.
In addition, the function/macro should not find cells that contain entries like CORPORATE, where PO is part of a word.
All the cells that contains qualifying data, should be highlighted.
This small UDF will return 1 is the match is present, otherwise 0
Public Function IsItThere(r As Range) As Long
Dim st As String
st = "0,1,2,3,4,5,6,7,8,9"
ary = Split(st, ",")
st = r.Text
IsItThere = 1
For Each a In ary
If InStr(1, st, "PO" & a) > 1 Then Exit Function
If InStr(1, st, "PO " & a) > 1 Then Exit Function
If InStr(1, st, "PO#" & a) > 1 Then Exit Function
If InStr(1, st, "PO# " & a) > 1 Then Exit Function
Next a
IsItThere = 0
End Function
You could also use Regular Expressions to find the pattern.
Try this:
Sub Tester()
Dim c As Range
For Each c In Selection.Cells
c.Interior.Color = IIf(RegexpTest(c.Value), vbRed, vbGreen)
Next c
End Sub
Function RegexpTest(v As String)
Static re As Object 'note static: you must reset the VB environment
' (press the "stop" button) if you edit the
' Pattern below
If re Is Nothing Then
Set re = CreateObject("VBScript.RegExp")
'"PO" then optional #, optional space, then 2-5 digits
re.Pattern = "PO#?\s?\d{2,5}"
re.ignorecase = True
End If
RegexpTest = re.test(v)
End Function
I´m trying to unify the format of a large .xlsx file I received.
One of the problems I found, is that there are entries which "unique code" is "00UTract 32", "132Unit 359", "5555UT22"... and then I´ve found we´ve "00 UTract 32", "Unit 359, 132", and "22UT, 5555".
As you may suspect, there are duplicates, and I confirmed that was the case.
So, how should I do to add a space each time I find a letter next to a number, so I can start cleaning the mess easily?
Thanks!!!
Select the cells you wish to check/correct and run this macro:
Sub DataFixer()
Dim r As Range, DoIt As Boolean
Dim temp As String, CH As String, v As String
Dim i As Long, L As Long
For Each r In Selection
temp = ""
DoIt = False
v = r.Value
L = Len(v)
CH = Mid(v, 1, 1)
temp = CH
For i = 2 To L
CH = Mid(v, i, 1)
If IsNumeric(Right(temp, 1)) And CH Like "[a-zA-Z]" Then
DoIt = True
temp = temp & " "
End If
temp = temp & CH
Next i
If DoIt Then r.Value = temp
Next r
End Sub
The macro checks each select cell for occurrences of:
{number}{letter}
and replaces them with:
{number} {letter}
I'd probably do this the other way around assuming that the only difference in IDs are the spaces.
Simply remove all spaces from that column, and you will get the same values, without having to deal with checking each character in a string.
This can be done via CTRL+H and no need to introduce VB in it.