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.
Related
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.
I have a list that was copied from a 'table of contents' page to column D. Unfortunately, each cell contains the chapter number, chapter name, and the page number.
3.14.4 chapter name placeholder.140
Sometimes there is a space between the page number and the last character. other times there is not.
I've tried
Function john(txt As String) As Long
Dim x
x = Split(Trim(txt), Chr(32))
john = Val(x(UBound(x)))
End Function
Which does work but I'd like to be able to apply this to the chapter number as well afterwards.
Private Sub FIND_LAST_NUMBER()
Dim A As String
Dim B As Integer
Dim C As String
Dim D As String
x = 3
Do While ActiveSheet.Cells(x, 4).Value <> ""
A = Range("D" & x).Value
A = Trim(A)
B = Len(A)
For Position = B To 1 Step -1
C = Mid(A, Position, 1)
'MsgBox C
If C <> " " Then
D = Right(A, B - Position)
Range("E" & x).Value = C
GoTo LastLine
'Exit Sub
End If
Next Position
LastLine:
x = x + 1
Loop
End Sub
but I'm trying to figure out how to get all of the number instead of only the last digit of the page number from the original cell
I am obviously not getting something here.
Any tips or tricks will be greatly appreciated
One, admittedly not very beautiful solution I can think of right away would be to use Replace to remove all non-numeric characters.
Dim str As String
str = Replace(str, " ", "") '<- to remove the random spaces
str = LCase(str) '<- making everything lower case
For i = 97 To 122
str = Replace(str, Chr(i), "")
Next i
Chr(i) with i from 97 to 122 will be every Character of the standard Alphabet.
This does not work if special Characters appear in the Chapter Name String. If the Chapter name contains numbers these will remain, but you could detect that case because UBound of the split array will be 1 greater than usual.
Also if you can quickly scan all the cells with your data for other unwanted Characters like - / or whatever might occur, you can also get rid of them with Replace
Performance of this solution might not be great but for a quick fix it might do..
Currently working on a script to highlight a row if a specific cell within the row contains a certain phrase (the cell contains more than just the specific phrase). However, when trying to test, I am seeing the error "Compile Error: End With without With" I can see both the With and End With in my code, although it is possible I have been looking at this for too long to notice the obvious. Can anyone notice anything that could be causing this within the code?
Sub Conversion()
Dim State As String
Dim County As String
Dim Date As String
Dim TC As String
Dim H As String
Dim Tmp As String
Dim m As Long
Dim x As Long
H = "not recognised"
With Sheets("Matched Date")
For Each cell In Sheet
m = UBound(Split(Rng.Value, H))
If m > 0 Then
Tmp = ""
For x = 0 To m - 1
Tmp = Tmp & Split(Rng.Value, H)(x)
.Characters(Start:=Len(Tmp) + 1, Length:=y).EntireRow.Color = RGB(252, 227, 3)
Tmp = Tmp & H
Next
End If
End With
Edit: Sorry about the amateurish code here, I'm not trained, just trying to do this based off simple online videos and google guides, as we have noone else to do this for us.
As mentioned above already, proper code indention is your friend. Doing so, your code looks like
With Sheets("Matched Date")
For Each cell In Sheet
m = UBound(Split(Rng.Value, H))
If m > 0 Then
Tmp = ""
For x = 0 To m - 1
Tmp = Tmp & Split(Rng.Value, H)(x)
.Characters(Start:=Len(Tmp) + 1, Length:=y).EntireRow.Color = RGB(252, 227, 3)
Tmp = Tmp & H
Next
End If
End With
That way, it's easy to spot that your 1st For loop is missing the closing Next.
This and similar error messages can be a bit misleading. It basically means "This code somehow misses a closing 'bracket'", if you think of the pairs With/End With, For/Next, Select/End Select etc. as opening/closing bracket pairs.
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.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
Lets say there is some text in a cell that reads
"this is a block of text (.7) and in this block of text (1.2) there are numbers (2.5) and these numbers need to be added together (.4)"
The answer to the sum of all these numbers would be .7+1.2+2.5+.4= 4.8
My question is, is there a way that I can have excel add all the numbers together from a block of text and just output the answer? It will always be the sum of the numbers and the numbers will always be positive. The amount of numbers will vary, it could be 2 it could be 15, could be anything.
What I have tried so far: I've tried "=sum" and highlighting the entire cell which always gives the answer "0"
Try the following User Defined Function:
Public Function Addum(rng As Range) As Double
Dim s As String, L As Long, temp As String
Dim CH As String
s = rng.Value
L = Len(s)
For i = 1 To L
CH = Mid(s, i, 1)
If CH Like "[0-9]" Or CH = "." Then
temp = temp & CH
Else
temp = temp & " "
End If
Next i
temp = Application.WorksheetFunction.Trim(temp)
arr = Split(temp, " ")
For Each a In arr
Addum = Addum + CDbl(a)
Next a
End Function
User Defined Functions (UDFs) are very easy to install and use:
ALT-F11 brings up the VBE window
ALT-I
ALT-M opens a fresh module
paste the stuff in and close the VBE window
If you save the workbook, the UDF will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the UDF:
bring up the VBE window as above
clear the code out
close the VBE window
To use the UDF from Excel:
=myfunction(A1)
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
and for specifics on UDFs, see:
http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
Macros must be enabled for this to work!
EDIT#1:
The original code tries to convert a standalone period into a number. Replace the original UDF with this version:
Public Function Addum(rng As Range) As Double
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' VERSION #2
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s As String, L As Long, temp As String
Dim CH As String
s = rng.Value
L = Len(s)
For i = 1 To L
CH = Mid(s, i, 1)
If CH Like "[0-9]" Or CH = "." Then
temp = temp & CH
Else
temp = temp & " "
End If
Next i
temp = Application.WorksheetFunction.Trim(temp)
arr = Split(temp, " ")
For Each a In arr
If IsNumeric(a) Then
Addum = Addum + CDbl(a)
End If
Next a
End Function
EDIT#2:
This version (VERSION 3) will only process numbers encapsulated in parens:
Public Function Addum(rng As Range) As Double
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' VERSION #3
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s As String, L As Long, temp As String
Dim CH As String
s = rng.Value
L = Len(s)
For i = 1 To L
CH = Mid(s, i, 1)
If CH Like "[0-9]" Or CH = "." Or CH = "(" Or CH = ")" Then
temp = temp & CH
Else
temp = temp & " "
End If
Next i
temp = Application.WorksheetFunction.Trim(temp)
arr = Split(temp, " ")
For Each a In arr
If Left(a, 1) = "(" Then
a = Mid(a, 2, Len(a) - 2)
If IsNumeric(a) Then
Addum = Addum + CDbl(a)
End If
End If
Next a
End Function
Here is a UDF using Regular Expressions which will add only those values that are within parentheses:
Option Explicit
Function sumNumsInParenth(S As String) As Double
Dim RE As Object, MC As Object, M As Object
Dim dSum As Double
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = True
.Pattern = "\((\d*(?:\.\d+)?)\)"
If .test(S) = True Then
Set MC = .Execute(S)
For Each M In MC
dSum = dSum + M.submatches(0)
Next M
End If
End With
sumNumsInParenth = dSum
End Function
Explanation of the Regex pattern
capture floating point numbers within parentheses, integer portion optional
\((\d*(?:\.\d+)?)\)
Options: Case insensitive; ^$ match at line breaks
Match the opening parenthesis character \(
Match the regex below and capture its match into backreference number 1 (\d*(?:\.\d+)?)
Match a single character that is a “digit” \d*
Between zero and unlimited times, as many times as possible, giving back as needed (greedy) *
Match the regular expression below (?:\.\d+)?
Between zero and one times, as many times as possible, giving back as needed (greedy) ?
Match the character “.” literally \.
Match a single character that is a “digit” \d+
Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
Match the closing parenthesis character \)
Created with RegexBuddy
This array formula will do it:
=SUM(IF(ISNUMBER(--TRIM(MID(SUBSTITUTE(SUBSTITUTE(A1,"(",REPT(" ",99)),")",REPT(" ",99)),(ROW(1:100)-1)*99+1,99))),--TRIM(MID(SUBSTITUTE(SUBSTITUTE(A1,"(",REPT(" ",99)),")",REPT(" ",99)),(ROW(1:100)-1)*99+1,99))))
Being an array formula it must be confirmed with Ctrl-Shift-Enter instead of Enter when exiting edit mode.