I'm trying to extract a date from a cell that is not in standard date format.
The Cell in Question has the string "10/9～10/13" in it.
I know this because I initially find the suspect cell by using a Range.Find function. (I tried .Value, .Value2, and .Text here to no avail).
text = .UsedRange.Find("~~").Value
If I use debug.Print text then
debug.Print text
10/9_10/13
Interestingly enough the ~ disappears. However, debug.Print also reveals this strange behavior.
d = InStr(1, "10/9_10/13", "_", vbTextCompare)
5
d = InStr(1, text, "_", vbTextCompare)
0
I thought perhaps text isn't a string?
debug.Print TypeName(text)
String
If you could explain why VBA is exhibiting this apparently inconsistent behavior that would be very useful.
As you have seen AscW returns -162, you can use that value to find the unicode char in vba
I put your data in D1 and then I ran:
Sub dural()
Dim dCell As String, txet As String
dCell = Range("D1").Value
Debug.Print dCell
txet = ActiveSheet.UsedRange.Find("~~").Value
Debug.Print txet
End Sub
(I used txet rather than text to avoid any confusion with the Property of the same name) and got:
Is it possible that what you have is not tilda but some other unicode character that looks like tilda?
Related
I am looking for a solution to validate and highlight my cell in case false.
I tried the most promising solution: Regex. But still can not find the pattern I need.
My latest attempt was this pattern: "[A-Z-0-9_.]" This works only if the cell contains only a symbol and nothing else, if the symbol is part of a string it does not work.
Problem is that it does not catch cells that have an odd character in a string of text: Example C4UNIT| or B$GROUP.
Specification Cell can contain only capital characters and two allowed symbols Dash - and Underbar _
This is my complete code:
Function ValidateCellContent()
Sheets("MTO DATA").Select
Dim RangeToCheck As Range
Dim CellinRangeToCheck As Range
Dim CollNumberFirst As Integer
Dim CollNumberLast As Integer
Dim RowNumberFirst As Integer
Dim RowNumberLast As Integer
'--Start on Column "1" and Row "3"
CollNumberFirst = 1
RowNumberFirst = 3
'--Find last Column used on row "2" (Write OMI Headings)
CollNumberLast = Cells(2, Columns.count).End(xlToLeft).Column
RowNumberLast = Cells(Rows.count, 1).End(xlUp).Row
'--Set value of the used range of cell addresses like: "A3:K85"
Set RangeToCheck = Range(Chr(64 + CollNumberFirst) & RowNumberFirst & ":" & Chr(64 + CollNumberLast) & RowNumberLast)
Debug.Print "Cells used in active Range = " & (Chr(64 + CollNumberFirst) & RowNumberFirst & ":" & Chr(64 + CollNumberLast) & RowNumberLast)
For Each CellinRangeToCheck In RangeToCheck
Debug.Print "CellinRangeToCheck value = " & CellinRangeToCheck
If Len(CellinRangeToCheck.Text) > 0 Then
'--Non Printables (Space,Line Feed,Carriage Return)
If InStr(CellinRangeToCheck, " ") _
Or InStr(CellinRangeToCheck, Chr(10)) > 0 _
Or InStr(CellinRangeToCheck, Chr(13)) > 0 Then
CellinRangeToCheck.Font.Color = vbRed
CellinRangeToCheck.Font.Bold = True
'--Allowed Characters
ElseIf Not CellinRangeToCheck.Text Like "*[A-Z-0-9_.]*" Then
CellinRangeToCheck.Font.Color = vbRed
CellinRangeToCheck.Font.Bold = True
Else
CellinRangeToCheck.Font.Color = vbBlack
CellinRangeToCheck.Font.Bold = False
End If
End If
Next CellinRangeToCheck
End Function
Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'we want only validate when cell content changed, if whole range is involved (i.e. more than 1 cell) then exit sub
If Target.Cells.Count > 1 Then Exit Sub
'if there is error in a cell, also color it red
If IsError(Target) Then
Target.Interior.ColorIndex = 3
Exit Sub
End If
'validate cell with our function, if cell content is valid, it'll return True
'if it i s not valid, then color cell red
If Not ValidateText(Target.Value) Then
Target.Interior.ColorIndex = 3
End If
End Sub
Function ValidateText(ByVal txt As String) As Boolean
Dim i As Long, char As String
'loop through all characters in string
For i = 1 To Len(txt)
char = Mid(txt, i, 1)
If Not ((Asc(char) >= 65 And Asc(char) <= 90) Or char = "-" Or char = "_") Then
'once we come upon invalid character, we can finish the function with False result
ValidateText = False
Exit Function
End If
Next
ValidateText = True
End Function
I've originally assumed you wanted to use RegEx to solve your problem. As per your comment you instead seem to be using the Like operator.
Like operator
While Like accepts character ranges that may resemble regular expressions, there are many differences and few similarities between the two:
Like uses ! to negate a character range instead of the ^ used in RegEx.
Like does not allow/know quantifiers after the closing bracket ] and thus always matches a single character per pair of brackets []. To match multiple characters you need to add multiple copies of your character range brackets.
Like does not understand advanced concepts like capturing groups or lookahead / lookbehind
probably more differences...
The unavailability of quantifiers leaves Like in a really bad spot for your problem. You always need to have one character range to compare to for each character in your cell's text. As such the only way I can see to make use of the Like operator would be as follows:
Private Function IsTextValid(ByVal stringToValidate As String) As Boolean
Dim CharValidationPattern As String
CharValidationPattern = "[A-Z0-9._-]"
Dim StringValidationPattern As String
StringValidationPattern = RepeatString(CharValidationPattern, Len(stringToValidate))
IsTextValid = stringToValidate Like StringValidationPattern
End Function
Private Function RepeatString(ByVal stringToRepeat As String, ByVal repetitions As Long) As String
Dim Result As String
Dim i As Long
For i = 1 To repetitions
Result = Result & stringToRepeat
Next i
RepeatString = Result
End Function
You can then pass the text you want to check to IsTextValid like that:
If IsTextValid("A.ASDZ-054_93") Then Debug.Print "Hurray, it's valid!"
As per your comment, a small Worksheet_Change event to place into the worksheet module of your respective worksheet. (You will also need to place the above two functions there. Alternatively you can make them public and place them in a standard module.):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValidationRange As Range
Set ValidationRange = Me.Range("A2:D5")
Dim TargetCell As Range
For Each TargetCell In Target.Cells
' Only work on cells falling into the ValidationRange
If Not Intersect(TargetCell, ValidationRange) Is Nothing Then
If IsTextValid(TargetCell.Text) Then
TargetCell.Font.Color = vbBlack
TargetCell.Font.Bold = False
Else
TargetCell.Font.Color = vbRed
TargetCell.Font.Bold = True
End If
End If
Next TargetCell
End Sub
Regular Expressions
If you want to continue down the RegEx road, try this expression:
[^A-Z0-9_-]+
It will generate a match, whenever a passed-in string contains one or more characters you don't want. All cells with only valid characters should not return a match.
Explanation:
A-Z will match all capital letters,
0-9 will match all numbers,
_- will match underscore and dash symbols.
The preceding ^ will negate the whole character set, meaning the RegEx only matches characters not in the set.
The following + tells the RegEx engine to match one or more characters of the aforementioned set. You only want to match your input, if there is at least one illegal char in there. And if there are more than one, it should still match.
Once in place, adapting the system to changing requirements (different chars considered legal) is as easy as switching out a few characters between the [brackets].
See a live example online.
I created a macro for removing all whitespace in a string, specifically an email address. However it only removes about 95% of the whitespace, and leaves a few.
My code:
Sub NoSpaces()
Dim w As Range
For Each w In Selection.Cells
w = Replace(w, " ", "")
Next
End Sub
Things I have tried to solve the issue include:
~ Confirmed the spaces are indeed spaces with the Code function, it is character 32 (space)
~ Used a substitute macro in conjuction with the replace macro
~ Have additional macro utilizing Trim function to remove leading and trailing whitespace
~ Made a separate macro to test for non-breaking spaces (character 160)
~ Used the Find and Replace feature to search and replace spaces with nothing. Confirmed working.
I only have one cell selected when I run the macro. It selects and goes through all the cells because of the Selection.Cells part of the code.
A few examples:
1 STAR MOVING # ATT.NET
322 TRUCKING#GMAIL.COM
ALEZZZZ#AOL. COM.
These just contain regular whitespace, but are skipped over.
Just use a regular expression:
'Add a reference to Microsoft VBScript Regular Expressions 5.5
Public Function RemoveWhiteSpace(target As String) As String
With New RegExp
.Pattern = "\s"
.MultiLine = True
.Global = True
RemoveWhiteSpace = .Replace(target, vbNullString)
End With
End Function
Call it like this:
Sub NoSpaces()
Dim w As Range
For Each w In Selection.Cells
w.Value = RemoveWhiteSpace(w.Value)
Next
End Sub
Try this:
Sub NoSpaces()
Selection.Replace " ", ""
End Sub
Use "Substitute"
Example...
=SUBSTITUTE(C1:C18," ","")
Because you assume that Selection.Cells includes all cells on the sheet.
Cells.Replace " ", ""
And to add to the excellent advice from all the great contributors, try the
TRIM or LTRIM, or RTRIM and you can read more about these functions here:
https://msdn.microsoft.com/en-us/library/office/gg278916.aspx
Now this does not remove embedded spaces (spaces in between the letters) but it will remove any leading and trailing spaces.
Hope this helps.
Space Problem with Excel
ok, the only way i see this two types of space is by converting their Ascii code value of which I do it here
now to explain this function i made, it will just filter the string character by character checking if its equal to the two types of space i mentioned. if not it will concatenate that character into the string which will be the final value after the loop. hope this helps. Thanks.
Function spaceremove(strs) As String
Dim str As String
Dim nstr As String
Dim sstr As String
Dim x As Integer
str = strs
For x = 1 To VBA.Len(str)
sstr = Left(Mid(str, x), 1)
If sstr = " " Or sstr = " " Then
Else
nstr = nstr & "" & sstr
End If
Next x
spaceremove = nstr
End Function
I copied a HTML table with data and pasted in excel but the cells were filled with unwanted space and all methods posted here didn't work so I debugged and I discovered that it wasn't actually space chars (ASCII 32) it was Non-breaking space) (ASCII 160) or HTML
So to make it work with that Non-breaking space char I did this:
Sub NoSpaces()
Dim w As Range
For Each w In Selection.Cells
w.Value = Replace(w.Value, " ", vbNullString)
w.Value = Replace(w.Value, Chr(160), vbNullString)
Next
End Sub
I have a difficult situation and so far no luck in finding a solution.
My VBA collects number figures like $80,000.50. and I'm trying to get VBA to remove the last period to make it look like $80,000.50 but without using right().
The problem is after the last period there are hidden spaces or characters which will be a whole lot of new issue to handle so I'm just looking for something like:
replace("$80,000.50.",".**.",".**")
Is this possible in VBA?
I cant leave a comment so....
what about InStrRev?
Private Sub this()
Dim this As String
this = "$80,000.50."
this = Left(this, InStrRev(this, ".") - 1)
Debug.Print ; this
End Sub
Mid + Find
You can use Mid and Find functions. Like so:
The Find will find the first dot . character. If all the values you are collecting are currency with 2 decimals, stored as text, this will work well.
The formula is: =MID(A2,1,FIND(".",A2)+2)
VBA solution
Function getStringToFirstOccurence(inputUser As String, FindWhat As String) As String
getStringToFirstOccurence = Mid(inputUser, 1, WorksheetFunction.Find(FindWhat, inputUser) + 2)
End Function
Other possible solutions, hints
Trim + Clear + Substitute(Char(160)): Chandoo -
Untrimmable Spaces – Excel Formula
Ultimately, you can implement Regular expressions into Excel UDF: VBScript’s Regular Expression Support
How about:
Sub dural()
Dim r As Range
For Each r In Selection
s = r.Text
l = Len(s)
For i = l To 1 Step -1
If Mid(s, i, 1) = "." Then
r.Value = Mid(s, 1, i - 1) & Mid(s, i + 1)
Exit For
End If
Next i
Next r
End Sub
This will remove the last period and leave all the other characters intact. Before:
and after:
EDIT#1:
This version does not require looping over the characters in the cell:
Sub qwerty()
Dim r As Range
For Each r In Selection
If InStr(r.Value, ".") > 0 Then r.Characters(InStrRev(r.Text, "."), 1).Delete
Next r
End Sub
Shortest Solution
Simply use the Val command. I assume this is meant to be a numerical figure anyway? Get rid of commas and the dollar sign, then convert to value, which will ignore the second point and any other trailing characters! Robustness not tested, but seems to work...
Dim myString as String
myString = "$80,000.50. junk characters "
' Remove commas and dollar signs, then convert to value.
Dim myVal as Double
myVal = Val(Replace(Replace(myString,"$",""),",",""))
' >> myVal = 80000.5
' If you're really set on getting a formatted string back, use Format:
myString = Format(myVal, "$000,000.00")
' >> myString = $80,000.50
From the Documentation,
The Val function stops reading the string at the first character it can't recognize as part of a number. Symbols and characters that are often considered parts of numeric values, such as dollar signs and commas, are not recognized.
This is why we must first remove the dollar sign, and why it ignores all the junk after the second dot, or for that matter anything non numerical at the end!
Working with Strings
Edit: I wrote this solution first but now think the above method is more comprehensive and shorter - left here for completeness.
Trim() removes whitespace at the end of a string. Then you could simply use Left() to get rid of the last point...
' String with trailing spaces and a final dot
Dim myString as String
myString = "$80,000.50. "
' Get rid of whitespace at end
myString = Trim(myString)
' Might as well check if there is a final dot before removing it
If Right(myString, 1) = "." Then
myString = Left(myString, Len(myString) - 1)
End If
' >> myString = "$80,000.50"
I've written simple code in VBA (and seen questions here and here and none of these solutions work).
Dim toString As String
toString = cell.Value & "_"
If (InStr(toString, ",")) Then
toString = Replace(toString, ",", ".")
toString = Trim(toString)
cell.Value = " " + Left(toString, (Len(toString) - 1))
End If
Unfortunately, instead of string with dot separator, excel gives me double with comma in cell.Value. What curious is, when I exchange this whitespace with "_", it converts f. ex. 12,3 into _12.3. How can I fix it?
P.S. I add "_" at the end to ensure that toString will remain String.
I've had this issue before. You need to change the formatting of the cell before you write to it.
Application.Workbooks("Book1").Sheets("Sheet1").Range("A1:A100").NumberFormat = "#"
After that line runs you can simply write to the column like this:
Cells(1,1).Value = "12.3"
Excel will keep the string formatting and not convert it to a double.
Hope this helps.
What I'm trying to do
Locate the column whose header cell contains a unique string. In other words, I know the cell's text, and I know the cell is in row 1, but I don't know which column. NOTE: I want to search for the entire text, not just part of it. NOTE2: The text can vary, so I cannot hardcode the value into my code. Rather I need to use the variable in which the value is stored.
The problem
When there's no carriage return in the header text, a simple newCol = Range("1:1").Find(headerText).Column works fine. However, if there is a carriage return, this doesn't work. It throws up the error "Object variable or With block variable not set". Here's my exact header string:
Incomplete Email
(more text)
What I've already tried
I also tried using WorksheetFunction.Match(headerText, Range("1:1"), 0), but got the same issue.
Additional notes and requirements
This is part of an add-in, so I do not want to change anything in the user's excel sheet if I don't have to (i.e., I don't want to remove the carriage return).
Technically, I'm doing this in a function:
Public Function getColumn(headerText As Variant)
getColumn = Range("1:1").Find(headerText).Column
End Function
Thanks!
pls try with below code
Public Function getColumn(headerText As String)
str1 = Split(headerText, vbCrLf)
str2 = UBound(str1)
b = Range("1:1").Find(str1(0) & Chr(10) & str1(1)).Column
End Function
Here's the thing: text with and without line break is NOT the same text hence the .Find fail. What you should do is a pattern lookup. I have just tested this and it works, provided that if there is no line break there shall be a space:
Sub test()
Dim rex As RegExp, ran As Range
Dim col As Integer, headerText As String
'read you headerText here
Set rex = New RegExp
rex.Pattern = RegexIt(headerText)
For Each ran In Range("1:1")
If rex.test(ran.Text) Then
col = ran.Column
Exit For
End If
Next ran
MsgBox col
End Sub
Function RegexIt(what As String) As String
what = Replace(what, "(", "\(")
what = Replace(what, ")", "\)")
what = Replace(what, "[", "\[")
what = Replace(what, "]", "\]")
what = Replace(what, "<", "\<")
what = Replace(what, ">", "\>")
what = Replace(what, " ", "[\n ]?")
what = Replace(what, vbCrLf, "[\n ]?")
End Function
Good luck!
Edit: Reference to Microsoft VBScript Regular Expressions 5.5 required
Edit2: Edited for variable use. Explanation: Replace space in variable value with optionel space/line break, escape brackets for pattern matching.
Your code should work even if the header cell contains carriage returns:
Sub FindColumnWithTextInRowOne()
Dim headerText As String, newCol As Long
headerText = "whatever"
newCol = Range("1:1").Find(headerText).Column
MsgBox newCol
End Sub
This is because your use of Find() does not require a match to the WHOLE contents of the cell.
EDIT#1:
If the header cell was constructed using a formula, then a slightly different Find() should be used:
Sub FindColumnWithTextInRowOne()
Dim headerText As String, newCol As Long, r As Range
headerText = Range("H1").Text
newCol = Range("1:1").Find(What:=headerText, LookAt:=xlWhole, LookIn:=xlValues).Column
MsgBox newCol
End Sub