I have a code that works, but I would like to simplify it, if possible.
This codes works when the value of a cell inside a range changes. It checks if the data inserted is a number, and then divides it automatically by one hundred, so I do not have to use the character that separate integers and decimals, and this makes a lot of diference when you have thousands of numbers to insert into sheet.
My code is:
Public Sub Worksheet_Change(ByVal Target As Range)
Set Intersecao = Intersect(Target, Range("ENTRANUMEROS"))
If (Not (Intersecao Is Nothing)) And (Not IsEmpty(Intersecao)) Then
On Error GoTo Fim
Dim Entrada As Double: Entrada = Intersecao.Value
Application.EnableEvents = False
If IsNumeric(Entrada) Then
Entrada = Entrada / 100
Intersecao.Value = Entrada
Else
MsgBox ("Invalid data.")
Intersecao.Value = ""
Intersecao.Select
End If
Application.EnableEvents = True
End If
Fim:
End Sub
In VBA you can use this:
Sub TestMe()
Application.FixedDecimal = True
Application.FixedDecimalPlaces = 2
End Sub
Use the Excel option Advanced > Automatically insert a decimal point > 2
to generally add a decimal point.
There is no way to have this only for a defined range besides using VBA to switch that option:
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Intersecao = Intersect(Target, Range("ENTRANUMEROS"))
If (Not (Intersecao Is Nothing)) And (Not IsEmpty(Intersecao)) Then
Application.FixedDecimal = True
Application.FixedDecimalPlaces = 2
Else
Application.FixedDecimal = False
End If
End Sub
Note that this example will not preserve the original state chosen by a user.
(Sorry for the german screenshot.)
Based on this comment of author:
I mean, insert from numeric keybord, say, 123456, and gets 1,234.56
automatically into the cell
You can devide by 100:
result = Format(Number/100, "#,##0.00")
Or, take last 2 digits as as decimals as substring:
result = MID(number, 1, LEN(number)-2)&"."& RIGHT(Number, 2)
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 tried to look for answers to this question but to no avail. I need this Macro to run on a specific worksheet called General on a specific workbook. The purpose, is to let the cell I24 be multiplied by 1.0003 every minute (which makes it a loop as far as I know). The below code only works when I have the General sheet opened. It stops looping when I switch to another worksheet.
Also, I want the macro to run automatically open opening the workbook, regardless of the General sheet being selected, so that I24 on the General sheet keeps getting multiplied without being redirected to the sheet. Just so you know, I have that cell referenced on various other sheets in the workbook, that is why I need the macro constantly running. Below is my code (It may not be at its optimum condition since I am very new to VBA):
Sub auto_open()
WshtNames = Array("General")
Application.ScreenUpdating = False
Dim num As Long
num = Sheets("General").Range("I24").Value
num = num * 1.0003
Range("I24").Value = num
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
Application.ScreenUpdating = True
End Sub
Thank you, I really appreciate your assistance.
Analyzing your code and making some suggestions to improve and remove unnecessary code
Switching Application.ScreenUpdating doesn't make much sense in this specific case, because there is only one update in Range("I24"). Therefore no gain if you turn it off.
There is only an advantage if you have many updates, so that they get performed all at once when switching Application.ScreenUpdating = True.
Use Option Explicit. This forces you to declare all your variables properly.
You set WshtNames but never use it, so this line can be removed.
Use Worksheets instead of Sheets unless you really need to use Sheets (Sheets also contains charts not only worksheets).
If num is Long then it can only contain integer/whole numbers. Therfore if you multiply num = num * 1.0003 it will automatically cast into Long which is the same result as num = num and that means it doesn't change anything. You will need to use at least Double or Decimal here.
You didn't specify a worksheet for the Range("I24").Value = num so Excel assumes that the range is in the active sheet. This is why your code fails when you select another sheet. Never let VBA guess the worksheet always specify the correct one Worksheets("General").Range("I24").Value = num.
So all together we can change your code from …
Sub auto_open()
WshtNames = Array("General") '(3) can be removed because WshtNames is never used
Application.ScreenUpdating = False '(1) dosn't make much sense
Dim num As Long '(5) wrong data type
num = Sheets("General").Range("I24").Value '(4) use worksheets
num = num * 1.0003 'see (5)
Range("I24").Value = num '(6) Always specify a worksheet
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
Application.ScreenUpdating = True
End Sub
Into this …
Option Explicit
Public Sub auto_open()
Dim num As Double
With Workheets("General") 'note we use a with statement to specify the sheet for the ranges (starting with a dot now!)
num = .Range("I24").Value
num = num * 1.0003
.Range("I24").Value = num
End With
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
End Sub
Or even shorter, because we don't need the num variable for that short calculation:
Option Explicit
Public Sub auto_open()
With Workheets("General") 'note we use a with statement to specify the sheet for the ranges (starting with a dot now!)
.Range("I24").Value = .Range("I24").Value * 1.0003
End With
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
End Sub
This part of the code has wrong logic:
Dim num As Long
num = Sheets("General").Range("I24").Value
num = num * 1.0003
Long is a whole number by specification. If you multiply it by 1.0003 it is the same as if it is multiplied by 1. Consider using Double instead.
Or Decimal, for better precision:
Dim num as Double
num = Sheets("General").Range("I24")
num = CDec(num * 1.0003)
You must set your cell as a variable.
Dim myCell as Range
Set myCell = ThisWorkbook.Worksheets("General").Range("I24")
and in the code:
myCell.Value = num
EDIT:
The whole code:
Sub auto_open()
WshtNames = Array("General")
Application.ScreenUpdating = False
Dim myCell As Range
Set myCell = ThisWorkbook.Worksheets("General").Range("I24")
myCell = myCell * 1.0003
Application.OnTime Now + TimeValue("00:01:00"), "auto_open"
Application.ScreenUpdating = True
End Sub
I'm using VBA to perform a search on a pivot field and I want to be able to do a search based on whether the field contains a portion of the string but am unsure of how to do this without checking for the whole value. Bellow is what I currently have:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'P4 is touched
If Intersect(Target, Range("B4")) Is Nothing Then Exit Sub
'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewPull As String
'Here you amend to suit your data
Set pt = Worksheets("Pull Code Search").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Pull Code")
If IsEmpty(Range("B3").Value) = True Then
NewPull = "(All)"
Else
NewPull = Worksheets("Pull Code Search").Range("B3").Value
End If
'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters
Field.CurrentPage = NewPull
If NewPull = "(All)" Then
ActiveSheet.PivotTables(1).PivotFields(1).ShowDetail = False
End If
pt.RefreshTable
End With
End Sub
Use INSTR.
This function returns the position of first occurrence of substring in a string. You no need to loop through the whole string.
If your portion of the string (substring) exists in the actual "string", this function returns a positive value.
"The INSTR function can only be used in VBA code in Microsoft Excel."
The syntax
InStr( [start], string, substring, [compare] )
More description here:
https://www.techonthenet.com/excel/formulas/instr.php
Hi I am trying to create a function to calculate milliohms (mOhms)
my function is
Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & Chr(87)
End Function
with results being
40.00 mW
(if cell values are 24 and 1 respectivly)
How do i get the W as (Ω) ohms symbol
if i change the cell font style to Symbol m changes to micro (μ) symbol
i have tried paying with
With ActiveCell.Characters(Start:=Len(ActiveCell) - 1, Length:=1).Font
.FontStyle = "Symbol"
End With
Which results in "Circular reference error"s
Need some help to resolve this
Try using Unicode in place of the Chr(87)
Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & ChrW(&H2126)
End Function
should you want to stick with Characters object you have to:
use Name property, instead of FontStyle one
set its Start parameter to the last character of the range text, instead of the second to last one
so you may want to code like follows:
Sub main()
With Range("G1") '<--| change this to any valid Range reference
.Value = mOhms(24, 1) '<--| set the referenced range value
FormatOhm .Cells '<--| format the referenced range value last character
End With
End Sub
Function mOhms(Current, Voltage)
mOhms = Format((Voltage / Current) * 1000, "00.00 m") & Chr(87)
End Function
Sub FormatOhm(rng As Range)
With rng
.Characters(Start:=Len(.Value), Length:=1).Font.name = "Symbol"
End With
End Sub
a possible enhancement of which could be the handling of "W" character actual position in the string, should it not always be the last character
then you could add the following function:
Function GetCharacter(rng As Range, char As String) As Long
Dim i As Long
With rng
For i = 1 To .Characters.Count
If .Characters(i, 1).Text = char Then
GetCharacter = i
Exit For
End If
Next i
End With
End Function
that returns a Long with the passed character position inside the passed range value or 0 if no match occurred
in this case you'd have to slightly change FormatOhm() function to have it handle the actual character position:
Sub FormatOhm(rng As Range, iChar As Long)
If iChar = 0 Then Exit Sub '<--| exit if no character matching occurred
With rng
.Characters(Start:=iChar, Length:=1).Font.name = "Symbol"
End With
End Sub
and your "main" code would then get to:
Sub main()
With Range("G1") '<--| change this to any valid Range reference
.Value = mOhms(24, 1) '<--| set the referenced range value
FormatOhm .Cells, GetCharacter(.Cells, "W") '<--| format the referenced range value character corresponding to "W", if any
End With
End Sub
of course what above could be further both improved and made more robust, for instance handling char parameter length in GetCharacter() and correspondingly in FormatOhm()
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.