I often get names in which I need to work with and reconcile some of their information. These names would often come in many different formats. The current VBA script I've got on is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Application.EnableEvents = False
Target.Value = StrConv(Target.Value, vbProperCase)
Application.EnableEvents = True
End If
On Error GoTo 0
End Sub
It does the trick with changing names to Proper case but I'm also hoping to automate capitalized names that has the surname in the front, separated with a comma (e.g. SMITH, JOHN).
In researching, I have found the following formula to work brilliantly, but this is not in VBA - I need it to auto convert the same cell:
=RIGHT(A1,LEN(A1)-LEN(LEFT(A1,FIND(",",A1)-1))-2) & " " & LEFT(A1,FIND(",",A1)-1)
Would there be anyway if I could have this formula functioning in the VBA script?
Lastly, it would amaze me if this script could recognize specialized surnames, especially capitalize the letter after a symbol (e.g. Mary-Lee / O'Connor).
Any suggestion would be greatly appreciated! Thanks in advance!
I converted your worksheet formula to VBA, you can use INSTR to get the same result as FIND, the arguments are passed to it in the opposite order but apart from that its the same. (I made a string called A1 to make it easier to compare to your example)
Dim A1 As String
A1 = Target.Value
If (InStr(A1, ",") > 0) Then
Target.Value = Right(A1, Len(A1) - Len(Left(A1, InStr(A1, ",") - 1)) - 2) & " " & Left(A1, InStr(A1, ",") - 1)
End If
This will capitalise the next character after an apostrophe, you can edit it to handle other punctuation
Dim A1 As String
A1 = Target.Value
Dim i As Integer
i = InStr(A1, "'") 'position of the '
If (i > 0 And Len(A1) > i) Then 'check there is a ' present and there is a character after it
Target.Value = Left(A1, i) & UCase(Mid(A1, i + 1, 1)) & Right(A1, Len(A1) - i - 1)
End If
Add just before you Application.EnableEvents = True line:
If InStr(Target.Value, ",") > 0 Then
Target.Value = UCase(Left(Target.Value, InStr(Target.Value, ",") - 1)) & Mid(Target.Value, InStr(Target.Value, ","), Len(Target.Value))
End If
NB: Add With Target as your first line of code and End With as your last and change all your Target.Value references to just .Value.
https://msdn.microsoft.com/en-us/library/wc500chb.aspx
Related
I do have a cell in excel that contains Σh. Not sure how to check for it in vba. I have tried with .Value and .Text, but the check is never true.
If (tRange.Value = (ChrW(931) + "h")) Then
Exit Sub
End if
When testing (Debug) I get this result for ActiveCell.Value = Sh
(a) You have to use .Value to get the content of the cell.
(b) You should use the ampersand character (&) to concatenate strings in VBA. The plus-sign works also, but only if all operands are strings.
(c) ChrW(931) & "h" (or ChrW(931) + "h") should work. VBA is able to handle characters even if the VBA-environment cannot show them.
Seems to me that either the Sigma-character is composed with a different character, or your cell contains invisible characters like space, newline, tabs...
You can dump the content of the cell with the following code to get an idea why your If-statement fails:
Sub DumpString(s As String)
Dim i As Long
For i = 1 To Len(s)
Dim c As String
c = Mid(s, i, 1)
Debug.Print i, AscW(c), c
Next
End Sub
When you enter the following command into the immediate window, you will see output like that:
DumpString activecell.Value
1 931 S
2 104 h
This should check if cell value contains the sub-string 'Σh'
If tRange.Value Like "*" & ChrW(931) & "h*" Then
Exit Sub
End If
Another maybe simpler way for some folks
If InStr(1, tRange.Value, ChrW(931) & "h") <> 0 Then
Exit Sub
End If
You have to use an ampersand to join the two characters:
If (tRange.Value = ChrW(931) & "h") Then
Exit Sub
End if
I was looking for a code to automatically insert the ':' (colon) into the columns R and S, W and X, and found code that I thought I could customise to my needs, but I am facing two issues:
The code works in R and S, but also need the code to run in columns W and X as well
I get an error:
Variable not Defined - stopping at TLen and I guess it will also stop at TimeV
The programmer doesn't use the Option Explicit, (it works OK without Option Explicit). But all my code is always with Option Explicit, but I'm not sure how to write the Dim for the two variables.
This code is in a specific worksheet, in the Worksheet_Change sub, where I have other code for other things, like the timestamp when people make a selection from column B, it will automatically populate when a selection is made in column B.
I have tried the colon code in another workbook, without the Option Explicit and it works without giving errors.
The source of the code came from
Excel VBA tips n tricks #12 no more colons when typing time of day, type 123 instead of 01colon23 AM
I've adapted the code to reference columns R and S in the code below.
Private Sub Worksheet_Change(ByVal Target As Range)
' This code will ADD the COLON for TIME automatically
' The code is from: https://www.youtube.com/watch?v=ATxaNbTV2d0 (Excel is Fun -
' Excel VBA Tips n Tricks #12 NO MORE COLONS When Typing Time of Day, Type 123 instead of 01colon23 AM
' To avoid an error if you select more than 1 cell, this next line of code will exit the sub
If Selection.Count > 1 Then
Exit Sub
End If
If Not Intersect(Range("R4:S1200"), Target) Is Nothing Then
TLen = Len(Target)
[![Layout of Worksheet and sample of the columns that need automatic insertion of colons ][1]][1]
If TLen = 1 Then
TimeV = TimeValue(Target & ":00")
ElseIf TLen = 2 Then
TimeV = TimeValue(Target & ":00")
ElseIf TLen = 3 Then
TimeV = TimeValue(Left(Target, 1) & ":" & Right(Target, 2))
ElseIf TLen = 4 Then
TimeV = TimeValue(Left(Target, 2) & ":" & Right(Target, 2))
ElseIf TLen > 4 Then
'Do nothing
End If
'Target.NumberFormat = "HH:MM"
Application.EnableEvents = False
Target = TimeV
Application.EnableEvents = True
End If
End Sub
Expand the range of the Intersect Intersect(Range("R:S,W:X"),Target).
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If IsNumeric(Target) = False Then
MsgBox Target & " is not a number", vbExclamation
Exit Sub
ElseIf Intersect(Range("R:S,W:X"), Target) Is Nothing Then
Exit Sub
End If
Dim n As Long
n = Len(Target)
If n >= 1 And n <= 4 Then
Application.EnableEvents = False
Target.NumberFormat = "hh:mm"
If n <= 2 Then
Target.Value2 = TimeSerial(Target, 0, 0)
Else
Target.Value2 = TimeSerial(Int(Target / 100), Target Mod 100, 0)
End If
Application.EnableEvents = True
End If
End Sub
I understand that you are 'stretching & teaching' me to work things out for myself, and it is appreciative (and I definitely have learned how to see the type (1.)). But in this instance, the 'Type' is coming as Variant/Date, even though it is meant to be time (maybe I am misunderstanding the syntax). – TheShyButterfly
You did well! Yes, that is one way to find the type. The other way is to use the VarType function:
Option Explicit
Sub Sample()
Dim TimeA
TimeA = TimeValue("01:00 PM")
MsgBox VarType(TimeA)
End Sub
This will give you 7 which is vbDate.
You can also store time as Variant and Double as shown below.
Option Explicit
Sub Sample()
Dim TimeA As Date
Dim TimeB As Double
Dim TimeC As Variant
TimeA = TimeValue("01:00 PM")
TimeB = TimeValue("01:00 PM")
TimeC = TimeValue("01:00 PM")
MsgBox "Time stored as Date : " & TimeA
MsgBox "Time stored as Double : " & TimeB
MsgBox "Time stored as Variant : " & TimeC
MsgBox "TimeA formated as Date : " & Format(TimeA, "hh:mm:ss AM/PM")
MsgBox "TimeB formated as Date : " & Format(TimeB, "hh:mm:ss AM/PM")
MsgBox "TimeC formated as Date : " & Format(TimeC, "hh:mm:ss AM/PM")
End Sub
but without an example how am I to learn, I have obviously exhausted my search on resolving this, but found nothing .. the reason why I posted the question. Thank you for encouraging me to continue solving things on my own :) TheShyButterfly
You can write the range as CDP1802 shown in his post or you can use the Application.Union method (Excel).
For example,
Option Explicit
Sub Sample()
Dim rngA As Range
Dim rngB As Range
Dim rngCombined As Range
Set rngA = Range("R4:S1200")
Set rngB = Range("W4:X1200")
Set rngCombined = Union(rngA, rngB)
MsgBox rngCombined.Address
End Sub
So in your code it becomes Intersect(rngCombined, Target) Is Nothing.
Also since you are working with Worksheet_Change and Events, I recommend seeing Working with Worksheet_Change.
I'm developing in VBA Excel and I discovered that I use WorksheetFunction.Trim(Cells(1,1)) where this cells contain any colored element, this element become colored by default.
Here is my code:
Cells(4, 2) = Application.WorksheetFunction.Trim(UCase(Cells(4, 2)))
Did you see this issue before ?
How can I remove blank in the text without this issue ?
Thanks for your help !
For cells with mixed formatting, replacing the cell value will lose the mixed format: instead you need to work with the cell's Characters collection:
Sub tester()
Dim c As Range
For Each c In Range("B3:B10").Cells
TrimAndUppercase c
Next c
End Sub
Sub TrimAndUppercase(c As Range)
Dim i, prevSpace As Boolean
If Len(c.Value) > 0 Then
'trim the ends of the text
Do While Left(c.Value, 1) = " "
c.Characters(1, 1).Text = ""
Loop
Do While Right(c.Value, 1) = " "
c.Characters(Len(c.Value), 1).Text = ""
Loop
'reduce runs of multiple spaces to a single space
For i = c.Characters.Count To 1 Step -1
With c.Characters(i, 1)
If .Text = " " Then
'was the previous character a space?
If prevSpace Then
.Text = "" 'remove this space
Else
prevSpace = True
End If
Else
.Text = UCase(.Text)
prevSpace = False
End If
End With
Next i
End If
End Sub
Note there are some limits to the length of the text using this method, and it can be a little slow with large ranges.
finally, I used this instruction.
Cells(4, 2) = Replace(UCase(Cells(4, 2)), " ", "")
In fact, my cell contain parameters and we perfers to avoid to have blank between them for visibility.
Please could you help me a little bit? I am a complete beginner, I don't know anything about programming.
I have the following code that changes double spaces into single spaces and deletes "..." if it's at the beginning of the selected cell(s).
Sub Test()
Dim X As Long, Cell As Range
For Each Cell In Selection
For X = Len(Cell.Text) To 1 Step -1
If Cell.Characters(X - 1, 2).Text = " " Then Cell.Characters(X, 1).Text = ""
If Cell.Characters(1, 3).Text = "..." Then Cell.Characters(1, 3).Text = ""
Next
Next
End Sub
Please could you tell me how I could change the part If Cell.Characters(1, 3).Text so that it removes "..." if it's at the end of the selected cell(s)?
This is not that easy as may seem, since Excel has the inclination to adjust three dots into an ellipsis, making it a single character that's unrecognizable when compared to a dot (or three). Furthermore, you don't need to loop characters 1 by 1, instead you could use Like to check if a cell is ending with the three dots, or rather the ellipsis. Next to that, we can trim excessive space characters in a Range in one go, using Application.Trim() as shown here.
So let's look at example data like:
Then if we select this Range and go over its cells using, for example:
Sub Test()
Dim cl As Range
For Each cl In Selection
If cl.Value Like "*..." Then
cl.Value = Left(cl.Value, Len(cl.Value) - 3)
ElseIf cl.Value Like "*" & ChrW(8230) Then
cl.Value = Left(cl.Value, Len(cl.Value) - 1)
End If
Next
Selection.Value = Application.Trim(Selection)
End Sub
The results would then be:
And for the sake of fun alternatives, a RegEx approach:
Sub Test2()
Dim cl As Range
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "…$|\.{3}$"
For Each cl In Selection
cl.Value = .Replace(cl.Value, "")
Next
End With
Selection.Value = Application.Trim(Selection)
End Sub
Maybe this can help you: Use the replace methode to change two spaces into one space. To search for three points at the beginning use the left methode and if it's the case, cut it out with the right methode. Here you have to watch out. Excel often replace three point by the character 133. So you have additional to test for it.
Sub Test()
Dim cell As Range
For Each cell In Selection
cell.Value = Replace(cell.Value, " ", " ")
If Left(cell.Value, 3) = "..." Then
cell.Value = Right(cell.Value, Len(cell.Value) - 3)
End If
If Left(cell.Value, 1) = Chr(133) Then
cell.Value = Right(cell.Value, Len(cell.Value) - 1)
End If
Next
End Sub
I think you can use Characters(1,3).Insert("") to change the text
Sub Test()
Dim c As Range
Selection.Value = Application.Trim(Selection)
For Each c In Selection
If c.Characters(1,3).Text = "..." Then c.Characters(1,3).Insert("")
Next
End Sub
In the following picture of an Excel sheet, the heading of the first column, and then of every 7th column after that, contains a month and a year.
I am trying to think of some code which would make entering complete dates under these headings faster. Since the month and the year are already present, I'm thinking there must be a way to enter just the day, and get the whole thing. For example, if "21" were entered in cell A26, "2/21/2015" would result.
Anyone have an idea for how I might get this output?
Edit: Thanks to the helpful replies on this forum, I figured out exactly how to do this. Here is the code for my finished product, in case anyone wants to do something similar:
Private Sub Worksheet_change(ByVal Selection As Range)
Set Sel = Selection
If Sel.Count > 1 Then
Exit Sub
End If
If (Sel.Column - 1) Mod 7 = 0 Or Sel.Column = 1 Then
'In my case, date columns always follow the pattern of 1, 8, 15...
If Sel.Value > 31 Or Sel.Value = "" Then
Exit Sub
Else
Sel.NumberFormat = "General"
Sel.Value = Left(Cells(1, Sel.Column), InStr(Cells(1, Sel.Column), ",") - 1) & " " & _
Sel.Value & Right(Cells(1, Sel.Column), 6)
Selection.NumberFormat = "m/d/yyyy"
End If
End If
End Sub
How about entering the day numbers, selecting the range where these day numbers are entered, and running the below:
Sub Add_month_year()
Dim c As Range
For Each c In Selection
c = Left(Cells(1, c.Column), InStr(Cells(1, c.Column), ",") - 1) & " " & _
c.Value & Right(Cells(1, c.Column), 6)
Next
End Sub
This should return the full dates in date code, which you can then format as you see fit.