I am using Excel 2010 and trying to make a function which will replace a part of the links in the Worksheet, depending on the user input. More specific I trying to replace the links to match the users Dropbox location.
This is the code I have so far
Private Sub CommandButton1_Click()
Dim DropboxFolder As String
Dim SearchFor As String
Dim SearchPos As Integer
SearchFor = "Dropbox"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
DropboxFolder = .SelectedItems(1)
For Each theHyperLink In ActiveSheet.Hyperlinks
SearchPos = InStr(0, SearchFor, theHyperLink.Address, vbBinaryCompare)
theHyperLink.Address = DropboxFolder
Next
Err.Clear
On Error GoTo 0
End With
End Sub
I have tried a debugging the code, and added a breakpoint at
SearchPos = InStr(0, SearchFor, theHyperLink.Address, vbBinaryCompare)
The SearchFor is "Dropbox" and TheHyperLink.Address is "..\Dropbox\Salgdanmarks Salgsakademi\1\Ny Microsoft Word Document.docx"
But the SearchPos is set to 0
What am I doing wrong?
I realized that the comments are temporary so I am putting this as an answer. This will help any future visitors as well.
The syntax of Instr is
InStr([start, ]string1, string2[, compare])
The InStr function syntax has these arguments:
start (Optional). Numeric expression that sets the starting position for each search. If omitted, search begins at the first character position. If start contains Null, an error occurs. The start argument is required if compare is specified.
string1 (Required). String expression being searched.
string2 (Required). String expression sought.
compare (Optional). Specifies the type of string comparison. If compare is Null, an error occurs. If compare is omitted, the Option Compare setting determines the type of comparison. Specify a valid LCID (LocaleID) to use locale-specific rules in the comparison
So in your case you need to reverse your variables.
SearchPos = InStr(1, theHyperLink.Address, SearchFor, vbTextCompare)
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 have a huge amount of data which is alphanumerical and I need to convert it to purely numerical. Which no text in the string.
Ex.
C0424.100 ---> 424.100 (or 0424.100)
There always is 3 places after the decimal. Any tips on how to go about this? I'm pretty new to VBA. So basically I need to remove all text and a decimal with three digits to the right of it.
This is well described in String functions and how to use them
However, this should get you started. I would handle the formatting in Excel afterwards, but this is the simple string to number conversion. If the strings are more complex, consider using the Search string function to find the numbers, then use Right, Left, Mid functions to trim the string. Lastly use the CDbl() function to convert the string to the double.
Macro code as follows:
Sub temp()
'
' temp Macro
Range("A2").Select
stringToConvert = Selection.Value
trimmedString = Right(stringToConvert, Len(stringToConvert) - 1)
numberToDisplay = CDbl(trimmedString)
Range("A3").Value = numberToDisplay
End Sub
Do you even need VBA? If your data always has just one leading alpha character then you can just use standard Excel functions. For an entry in A2 that you want to convert, place the following formula in a convenient cell (e.g. B2):
=VALUE(RIGHT(A2,LEN(A2)-1))
I got UDF options for you.
Option 1: If you want to remove all the alphas from the beginning of string:
Function RemoveFirstAlphas(txt As String) As String
Dim i As Long
For i = 1 To Len(txt)
Select Case Mid$(txt, i, 1)
Case "0" To "9": Exit For
Case Else: Mid$(txt, i, 1) = Chr(32)
End Select
Next
RemoveFirstAlphas = Trim(txt)
End Function
Option 2: If you want to remove all the alphas from entire string:
Function RemoveAllAlphas(txt As String) As String
Dim ObjRegex As Object
Set ObjRegex = CreateObject("vbscript.regexp")
With ObjRegex
.Global = True
.Pattern = "[a-zA-Z\s]+"
RemoveAllAlphas = .Replace(Replace(txt, "-", Chr(32)), vbNullString)
End With
End Function
No need for VBA. Something like:
=--MID(A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),99)
will return the string starting with the first digit, and convert it to a numeric value. You can then format it in the cell however you wish.
The above will work with any number of non-digit leading characters. If will only have a single non-digit character, then #Skippy answer is simpler
If you have to have a VBA routine, something like the following should work -- it will extract the first numeric substring in the string. It does not matter if there are non-digits before or after. And, if there are no digits, the function will return the #NUM! error
Option Explicit
Function ExtractNums(S As String) As Variant
Dim I As Long
For I = 1 To Len(S)
If IsNumeric(Mid(S, I, 1)) Then
ExtractNums = Val(Mid(S, I))
Exit Function
End If
Next I
ExtractNums = CVErr(xlErrNum)
End Function
To prevent errors, I need to check if a String retrieved from a custom input box is not a valid hex color code. So far I found various solutions for other languages, but none for VBA.
Working on the following code, giving a not hex value input will cause a run time error. That's critical to my project, since I am working on a protected sheet.
Public Function HexWindow(MyCell As String, Description As String, Caption As String)
Dim myValue As Variant
Dim priorValue As Variant
priorValue = Range(MyCell).Value
myValue = InputBox(Description, Caption, Range(MyCell).Value)
Range(MyCell).Value = myValue
If myValue = Empty Then
Range(MyCell).Value = priorValue
End If
tHex = Mid(Range(MyCell).Text, 6, 2) & Mid(Range(MyCell).Text, 4, 2) & Mid(Range(MyCell).Text, 2, 2)
Range(MyCell).Interior.Color = WorksheetFunction.Hex2Dec(tHex)
End Function
How can I set a condition that recognizes a value not being in the format of "#" & 6 characters from 0-9 and A-F in any case?
Couple ways to do this. The easiest way is with a regular expression:
'Requires reference to Microsoft VBScript Regular Expressions x.x
Private Function IsHex(inValue As String) As Boolean
With New RegExp
.Pattern = "^#[0-9A-F]{1,6}$"
.IgnoreCase = True 'Optional depending on your requirement
IsHex = .Test(inValue)
End With
End Function
If for some reason that doesn't appeal to you, you could also take advantage of VBA's permissive casting of hex strings to numbers:
Private Function IsHex(ByVal inValue As String) As Boolean
If Left$(inValue, 1) <> "#" Then Exit Function
inValue = Replace$(inValue, "#", "&H")
On Error Resume Next
Dim hexValue As Long
hexValue = CLng(inValue) 'Type mismatch if not a number.
If Err.Number = 0 And hexValue < 16 ^ 6 Then
IsHex = True
End If
End Function
I would use regular expressions for this. First you must go to Tools-->Referencesin the VBA editor (alt-f11) and make sure this library is checked
Microsoft VBScript Regular Expressions 5.5
Then you could modify this sample code to meet your needs
Sub RegEx_Tester()
Set objRegExp_1 = CreateObject("vbscript.regexp")
objRegExp_1.Global = True
objRegExp_1.IgnoreCase = True
objRegExp_1.Pattern = "#[a-z0-9]{6}"
strToSearch = "#AAFFDD"
Set regExp_Matches = objRegExp_1.Execute(strToSearch)
If regExp_Matches.Count = 1 Then
MsgBox ("This string is a valid hex code.")
End If
End Sub
The main feature of this code is this
objRegExp_1.Pattern = "#[a-z,A-Z,0-9]{6}"
It says that you will accept a string that has a # followed by any 6 characters that are a combination of upper case or lower case strings or numbers 0-9. strToSearch is just the string you are testing to see if it is a valid color hex string. I believe this should help you.
I should credit this site. You may want to check it out if you want a crash course on regular expressions. They're great once you learn how to use them.
I am trying to validate the data types of all cells in a user-selected range are the same, using a VBA function. I have the following code (simplified), which works for the most part:
Dim vTempRange As Variant
Dim vCell As Variant
vTempRange = DataRange.Value
For Each vCell In vTempRange
If Len(vCell) > 0 Then
'Use TypeName(vCell)
'Complete validation here
End If
Next vCell
Sometimes a user may select a column of percentages, sometimes a column of decimal values, and sometimes a time value (not associated with a date). VBA seems to see all three of these as a Double, which is technically not incorrect. The problem is, the format of the selection will be used as part of the final output, so 12:00:00 should display as such, and not 0.50, which is currently the case.
I looked into using something like this in conjunction:
Dim vCell As Variant
For Each vCell In DataRange
If Len(vCell) > 0 Then
'Use vCell.NumberFormat
'Complete validation here
End If
Next vCell
But the NumberFormat is not consistent. e.g., a user may have a percent listed as 0% vs. 0.000% or a time as h:m:s vs. hh:mm:ss, so I see it as being difficult to correctly capture this value.
Is there a way to accurately determine without user intervention when a time is selected vs. one of the other types? Determining a percent value versus a 0<x<1 decimal value would also be nice, but not required.
I have other options at my disposal, such as ignoring the formatting in the final output (really not desirable) or explicitly asking the user to identify the type (but this is neither as clean nor automatic as I would like).
Try this. Paste this in a module. You can then use it as a Worksheet formula.
I had this code in my database which was picked up from here and I modified it to suit your needs.
Public Function CellType(c)
Application.Volatile
Select Case True
Case IsEmpty(c): CellType = "Blank"
Case Application.IsText(c): CellType = "Text"
Case Application.IsLogical(c): CellType = "Logical"
Case Application.IsErr(c): CellType = "Error"
Case IsDate(c): CellType = "Date"
Case InStr(1, c.Text, ":") <> 0: CellType = "Time"
Case InStr(1, c.Text, "%") <> 0: CellType = "Percentage"
Case IsNumeric(c): CellType = "Value"
End Select
End Function
ScreenShot
You can further modify it to add an IF clause inside Case IsNumeric(c): CellType = "Value" to check for decimals, Scientific notation etc using INSTR
Declare vCell as Range and then do your check:
TypeName(vCell.Value)
That will accurately catch your dates.
YOu will likely need to add some if/then logic to capture "percents" since these are double-type values -- the "%" part is merely cell formatting, so you may be able to just check the Right(vCell.NumberFormat,1) = "%" .
VarType function
Returns an Integer indicating the subtype of a variable, or the type of an object's default property.
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/vartype-function
Ex1: using to write if.
Function DataType(x As Variant) As String
If VarType(x) = vbDate Then
DataType = "Date"
ElseIf VarType(x) = vbString Then
DataType = "String"
'.....
End If
End Function
Ex2: concatenate cells in range having value.
Function ConcatenateRange(cellRange As Range) As String
Dim cel As Range, temp As String
temp = ""
For Each cel In cellRange
'use VarType to check if the cell is empty.
'if the cell is not empty concatinate it.
If VarType(cel) <> vbEmpty Then
temp = temp & cel
End If
Next
ConcatenateRange = temp
End Function
I am currently coding a form in excel. I was wondering if there was a way to search the contents of a field for certain characters. I was thinking about using this method to construct a code to check for the integrity of the data entered within the email field. It would look for an "#" and a "." and probably output a boolean value (true or false) if there are not there.
Thank you in advance.
You could pass the value into a function like this:
Function blnValidEmail(strText As String) As Boolean
Dim intPosAt As Integer
Dim intPosDot As Integer
'finds the position of the # symbol'
intPosAt = InStr(strText, "#")
'finds the position of the last full stop'
'checks the last full stop because you might'
'have an address like jane.doe#something.com'
intPosDot = InStrRev(strText, ".")
'makes sure that both exist'
If intPosAt > 0 And intPosDot > 0 Then
'makes sure that there is a fullstop after the #'
If intPosDot > intPosAt Then
blnValidEmail= True
End If
End If
End Function