I realise that this is sort of a duplicate question, but the solutions mentioned in this question don't work for me completely.
My current code is as follows
Sub ConvertTextToNumber()
Dim Area As Range, C As Range
Set Area = Sheets("Tank 3").Range("C7:L7,B8:B17,C20:L20,B21:B69")
For Each C In Area
If WorksheetFunction.IsNumber(Celle) = False And C <> "" Then
C.NumberFormat = "0.0"
C.Value = C.Value + 0
End If
Next C
End Sub
This works fine on integers, but the moment the number stored as text is a decimal such as 0,1 or 0,2, it simply converts the number to 1 or 2 respectively.
I've tried using C.value = c.value after setting the NumberFormat to numbers or general, but that does nothing for me
Update: It seems the problem lies with the separators. I have to use "," as the decimal separator, and this makes the sub malfunction. If I swap the decimal separator to "." the sub runs fine.
Simply use Range.FormulaLocal to automatically cast a string to a number based on your regional settings:
Sub ConvertTextToNumber()
Dim Area As Range, C As Range
Set Area = Sheets("Tank 3").Range("C7:L7,B8:B17,C20:L20,B21:B69")
For Each C In Area
C.FormulaLocal = C.Value
Next
End Sub
You can change the separators through VBA:
Sub ChangeSeparator()
Application.DecimalSeparator = "."
Application.ThousandsSeparator = ","
Application.UseSystemSeparators = False
ConvertTextToNumber
Application.UseSystemSeparators = True
End Sub
You can use a little trick and that would be to import all the numbers as text in to your code then manipulate it and spit it back out. The comma confuses english conversions and would see 2,0 as 20. Anyway here's how you could do it
Sub ConvertTextToNumber()
Dim Area As Range, C As Range
Dim InNumAsStr As String
Set Area = Sheets("all").Range("A1:B10")
For Each C In Area
InNumAsStr = C.Text '*** force the value to be a string type ***
'***swap out any commas with decimal points ***
InNumAsStr = Replace(InNumAsStr, ",", ".")
C.NumberFormat = "0.0"
C.Value = InNumAsStr
Next C
End Sub
Related
I would like to convert a range of numbers (and single digits) from a number-only format to alpha-numeric format. Entire statement is in a single, excel cell and would like the converted version to be in a neighboring cell.
As an example:
Assuming 1-24=B1-B24
Assuming 25-48=C1-C24
INPUT—
screen 1-3,5,7-9,11-30,32-37,39-40,41,44-46
DESIRED OUTPUT (all acceptable)
screen B1-B3,B5,B7-B9,B11-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24,C1-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24
screen C1-C6,C8-C13,C15-C16,C17,C20-C22
Using excel functions is proving quite cumbersome so excel macro would be better. I've looked for examples of requested conversion but haven't found anything.
Any help is greatly appreciated.
Cheers,
Bob
Hey here is a solution that i tested out. Not sure if "screen" needs to be in the string or not. Let me know and I will tweak it if that's the case.
Its a user defined function. So drop this vba in a module and then go to a worksheet and type in "=AlphaConvert(" + the cell reference.
Assumption here is that only one cell will be referenced at a time.
Last this could easily be converted to a sub routine and probably run a bit faster than the function.
Public Function AlphaConvert(TargetCell As Range)
Dim v As Long
Dim vArr() As String
Dim i As Long
Dim iArr() As String
Dim a As String
vArr = Split(TargetCell.Value, ",")
For v = LBound(vArr) To UBound(vArr)
If InStr(vArr(v), "-") > 0 Then
iArr = Split(vArr(v), "-")
For i = LBound(iArr) To UBound(iArr)
If i = LBound(iArr) Then
a = AlphaCode(iArr(i))
Else
a = a & "-" & AlphaCode(iArr(i))
End If
Next i
vArr(v) = a
Else
vArr(v) = AlphaCode(vArr(v))
End If
If v = LBound(vArr) Then
AlphaConvert = vArr(v)
Else
AlphaConvert = AlphaConvert & "," & vArr(v)
End If
Next v
End Function
Private Function AlphaCode(Nbr As Variant)
Select Case Nbr
Case 1 To 24
AlphaCode = "B" & Nbr
Case Else
AlphaCode = "C" & Nbr - 24
End Select
End Function
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 need to be able to convert time values stored as text to number. Those that have been stored as text appear to be negative values, in this format -0:03. I need to be able to use these numbers in calculations.
Can someone advise how to fix as nothing seems to work.
Select the cells that contain the negative text time values and run this small macro:
Sub ConvertNegativeTime()
Dim r As Range, v As String
Dim t As Date
For Each r In Selection
With r
v = .Text
If Left(v, 1) = "-" Then
ary = Split(Mid(v, 2), ":")
t = TimeSerial(ary(0), ary(1), 0)
.Clear
.Value = -CDbl(t)
End If
End With
Next r
End Sub
If A1 contains your posted value, after running the macro it would contain:
-0.020833333
I am fairly new to VBA and having some general obstacles with basic syntax. I am using the below code to trim leading spaces and color code an ActiveSheet I am currently working on.
I have another Worksheet called "Country" that I would like to apply the same logic to the current sheet I am using. I am also having difficulties using the most efficient code to find any cells with values of "AcctTotal" , " CurrTotal" and " BravoTotal" (there are about 14,000 rows of data). I am currently highlighting the whole spreadsheet and utilizing "UsedRange" to find these cells.
To sum it up:
I would like to trim leading spaces and color code any values of "AcctTotal" , " CurrTotal" and " BravoTotal" in two worksheets: "Currency" and "Country"
Sub ColorCodeCurrency()
Dim r As Range
For Each r In Selection
If r.Value = " AcctTotal" Then
r.Value = LTrim(r.Value)
Intersect(r.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 15
End If
Next r
Dim s As Range
For Each s In Selection
If s.Value = " CurrTotal" Then
s.Value = LTrim(s.Value)
Intersect(s.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 40
End If
Next s
Dim t As Range
For Each t In Selection
If t.Value = " BravoTotal" Then
t.Value = LTrim(t.Value)
Intersect(t.EntireRow, ActiveSheet.UsedRange).Interior.ColorIndex = 35
End If
Next t
End Sub
Most of the problem is that you're doing the same thing three times. The 'For Each' statement is going through every cell three times. If you joined it into
for each r in selection
if r.value ="AcctTotal" then
'do something
elseif r.value = "CurrTotal" then
'do something else
elseif r.value = "BravoTotal" then
'do the third thing
end if
In addition to what Maudise said, when you refer to your data, you can use syntax like:
Sheets("Country").Range("A1:E14000")
If it's possible to make changes to your source data, you may find it helpful to format it as a table for easy reference. Use the Name Manager to give the table a useful name. Then, you can say something like:
For Each r In Sheets("Country").Range("CountryTable")
You could try this way:
Public Sub ColorCode ()
Dim i As Integer, j As Integer, m As Integer, n As Integer
i = Range("A:A").End(xlDown).Row
j = Cells.End(xlToRight).Column
For m = 1 To i
For n = 1 To j
If Cells(m, n).Value < 50 Then
Cells(m, n).Interior.ColorIndex = 13
End If
Next n
Next m
End Sub
One solution is to call this code placed in a module into "This workbook" in "Private Sub Workbook_Open()".
In this case, I want to extract the beginning text in a cell and leave the remainder intact.
e.g. a series of cells contain:
2nd Unit. Miami
3rd Production Staff. Toronto
1st Ad. San Francisco
I want to break this up without using Text to columns as previous rows are formatted differently and these last few rows are outliers that I want to handle.
I thought Regular Expressions might do it, but that seems a bit complex.
My algorithm idea is:
1. grab the wanted text (what function or custom sub would do that?)
2. Past the text to it's new location
3. Cut the text from the cell, leaving the remaining text.
Seems simple but I'm still wending my way through VBA forest, and at the rate I'm going it's going to end up faster doing it by hand. But this seems like a good opportunity to learn some VBA tricks.
TIA
Update:
I want to take the text up to the ".\ " and move it to a different column, keeping the remainder where it is.
VBA is unnecessary. To get the text after .\ in cell A1: =MID(A1,FIND(".\",A1,1)+2,LEN(A1)) to get the text before .\ in A1: =LEFT(A1,FIND(".\",A1,1)-1).
As additional information, Find returns the placement in the string where .\ appears. It is the equivalent of InStr in VBA. If .\ is not in the cell, it will display #VALUE, because I didn't bother to add error checking.
Since you seem to want to modify the cell text in place, VBA will be required.
Inside a loop that sets cl to the cell to be processed:
str = cl.value
i = Instr(str, ".\")
cl = Trim(Mid$(str, i + 2)) ' assuming you want to exclude the ".\"
cl.Offset(0, 1) Trim(Left$(str, i - 1)) ' Places the original first part one cell to the right
For the sake of anyone who had this same question, here is the fully tested, working code.
Function RE6(strData As String) As String
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "[0-9][0-9][0-9][0-9]B"
RE6 = .test(strData)
End With
Set REMatches = RE.Execute(strData)
If REMatches.Count > 0 Then
RE6 = True
Else
RE6 = False
End If
End Function
Sub territory()
Dim strTest As String, str As String, cl As Range
strTest = ActiveCell.Value
Set cl = ActiveCell
If RE6(strTest) = True Then
str = cl.Value
i = InStr(str, ". ")
cl = Trim(Mid$(str, i + 2))
cl.Offset(0, 1) = Trim(Left(str, i - 1))
cl.Offset(0, 2) = "Instance"
MsgBox RE6(strTest)
End If
End Sub