Help with Sentence Case

[zoom38]

Good afternoon, I found this code on the net to change the cell contents to "Sentence Case". My problem with it, is that it is changing all cell contents to sentence case when I only want the active cell changed. The following code is in a module that is called from worksheet change event. Can some one take a look and advise.


Sub SentenceCase(rng As String)

Dim rngsource As Range
Dim cell As Range
Dim s As String
Dim Start
Dim i As Long
Dim ch As String

Set rngsource = Range(ActiveCell.address)

For Each cell In rngsource.SpecialCells(xlCellTypeConstants, 2)
s = cell.Value
Start = True
For i = 1 To Len(s)
ch = Mid$(s, i, 1)
Select Case ch
Case "."
Start = True
Case "?"
Start = True
Case "!"
Start = True
Case "a" To "z"
If Start Then ch = UCase$(ch)
Start = False
Case "A" To "Z"
If Start Then
Start = False
Else
ch = LCase$(ch)
End If
End Select
Mid$(s, i, 1) = ch
Next i
cell.Value = s
Next cell
End Sub



Called from worksheet change event code


If Not Intersect(Target, myrange2) Is Nothing Then
SentenceCase (myrange2)
End If

Thanks
Gary

[SamT]

You'll need to show us the worksheet Change code.

From a User's Point of View, what is supposed to happen when? What did or is the User doing at that time?

[zoom38]

Here is the worksheet change code.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim myrange As Range

Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect

Set myrange = Range("B9:B15,B19:B22,B27:B36,F9:F15,F19:F22,F27:F36,H45,G46")
Set myrange2 = Range("B38")
On Error Resume Next

'Sets Cells in myrange to Proper Case
If Not Intersect(Target, myrange) Is Nothing Then
Target.Value = WorksheetFunction.proper(Target.Value)
End If

If Not Intersect(Target, myrange2) Is Nothing Then
SentenceCase (myrange2)
End If

If Not Intersect(Target, Range("$K$47")) Is Nothing Then
aCell = Range("K47")
End If

If Range("N3").Value = "" Then
Range("N3").Value = "MM/DD/YY"
End If
If Range("N3").Value <> "MM/DD/YY" Then
Range("N3").Font.ColorIndex = 0
Else: Range("N3").Font.ColorIndex = 15
End If

If Range("R3").Value = "" Then
Range("R3").Value = "MM/DD/YY"
End If
If Range("R3").Value <> "MM/DD/YY" Then
Range("R3").Font.ColorIndex = 0
Else: Range("R3").Font.ColorIndex = 15
End If

If Range("N4").Value = "" Or Range("N4").Value = "hhmm" Then
Range("N4").Value = "HHMM"
End If
If Range("N4").Value <> "HHMM" Then
Range("N4").Font.ColorIndex = 0
Else: Range("N4").Font.ColorIndex = 15
End If

If Range("R4").Value = "" Or Range("R4").Value = "hhmm" Then
Range("R4").Value = "HHMM"
End If
If Range("R4").Value <> "HHMM" Then
Range("R4").Font.ColorIndex = 0
Else: Range("R4").Font.ColorIndex = 15
End If

If Range("R3").Value < Range("N3").Value Then
MsgBox ("The End Date Cannot Be Earlier Then The Start Date;" & vbCrLf & _
" Please Verify and Re-Enter The Date.")
Range("R3").Value = "MM/DD/YY"
Range("R3").Font.ColorIndex = 15
Range("R3").Select
End If
If Range("N3").Value = Range("R3").Value Then
If Range("R4").Value < Range("N4").Value Then
MsgBox ("The End Time Cannot Be Earlier Then The Start Time For An Event on the Same Date." & _
" Please Verify and Re-Enter The Time.")
Range("R4").Value = "HHMM"
Range("R4").Font.ColorIndex = 15
Range("R4").Select
End If
End If

'Last Line
If Range("K47").Value = "" Then
Range("K47").Value = "MM/DD/YY"
End If
If Range("K47").Value <> "MM/DD/YY" Then
Range("K47").Font.ColorIndex = 0
Else: Range("K47").Font.ColorIndex = 15
End If
If Range("R47").Value = "" Or Range("R47").Value = "hhmm" Then
Range("R47").Value = "HHMM"
End If
If Range("R47").Value <> "HHMM" Then
Range("R47").Font.ColorIndex = 0
Else: Range("R47").Font.ColorIndex = 15
End If

If aCell = Range("K47") Then
Range("R47").Activate
End If

ActiveSheet.Protect
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub



To answer your questions, after typing into cell B38, the code correctly changes the cell content to sentence case. However it is also changing the contents of the rest of the worksheet to sentence case. I only want the active cell changed. Is there a way to modify the code so that only the active cell is changed by the code?

[SamT]

See if this SentenceCase sub works for you.

Sub SentenceCase(rng As Range)
Dim V As Variant
Dim s As String
Dim Start As Boolean
Dim i As Long
Dim ch As String

Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect

With rng
V = .Value
If IsDate(V) Or IsNumeric(V) Then Exit Sub
s = CStr(V)
Start = True

For i = 1 To Len(s)
ch = Mid$(s, i, 1)
Select Case ch
Case "."
Start = True
Case "?"
Start = True
Case "!"
Start = True
Case "a" To "z"
If Start Then ch = UCase$(ch)
Start = False
Case "A" To "Z"
If Start Then
Start = False
Else
ch = LCase$(ch)
End If
End Select
Mid$(s, i, 1) = ch
Next i
.Value = s
End With

ActiveSheet.Protect
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Another problem you have is that the Worksheet Change sub is too overloaded. It should look like this, which only checks for the changed cell and selects a sub to run against it. Note that every sub it calls should have Protection, Screen Updating, and Events Enabling code.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myrange As Range
Set myrange = Range("B9:B15,B19:B22,B27:B36,F9:F15,F19:F22,F27:F36,H45,G46")

If Not Intersect(Target, myrange) Is Nothing Then SetProper Target

Select Case Target.Address
Case "$B$38"
SentenceCase Target
Case "$K$47", "$N$3", "$R$3"
CheckDates Target
Case "$N$4", "$R$4", "$R$47"
CheckHours Target
End Select
End Sub

[Paul_Hossler]

SamT's SentenceCase sub is much better than the original


I was still trying to figure out ...

1. why you pass a string as 'rng' to the SentenceCase sub, but always seem to use the ActiveCell's address
2. Instead of just Set rngsource = ActiveCell, the more obscure method was used
3. since rngsource is just one cell, the For Each is unneeded
4. In the event, 'myrange' is hard coded to B38, passed to the SentenceCase sub as a range, but the sub is expecting a string. If B38 contains a string that can be interpreted as a cell address it might work

I think removing the On Error Resume Next to let it fail would find a lot of issues




Sub SentenceCase(rng As String)


Set rngsource = Range(ActiveCell.address)

For Each cell In rngsource.SpecialCells(xlCellTypeConstants, 2)



It's not clear if you want SentenceCase to handle multiple cells or a single cell. If you want multiple cells, you might need something like this



Sub SentenceCase(rng As String)
Dim rngsource As Range
Dim cell As Range
Dim s As String
Dim Start As Long
Dim i As Long
Dim ch As String

On Error Resume Next
Set rngsource = rng.SpecialCells(xlCellTypeConstants, 2)
On Error GoTo 0

If rngsource Is Nothing Then Exit Sub

For Each cell In rngsource.Cells
s = cell.Value
Start = True
For i = 1 To Len(s)
ch = Mid$(s, i, 1)
Select Case ch
Case "."
Start = True
Case "?"
Start = True
Case "!"
Start = True
Case "a" To "z"
If Start Then ch = UCase$(ch)
Start = False
Case "A" To "Z"
If Start Then
Start = False
Else
ch = LCase$(ch)
End If
End Select
Mid$(s, i, 1) = ch
Next I
cell.Value = s
Next cell
End Sub

[SamT]

@ Paul

would this work

Dim Str As String
dim Rng As Range
Set Rng = Str.SpecialCells(xlCellTypeConstants, 2)

[zoom38]

SamT I love the way you cleaned it up. I slimmed down the worksheet change code and moved my if/then statements to separate subs in a module as you suggested. One issue, if the delete key is pressed, the code skips the select case. That is why I had all of the If/Then statements in the worksheet change code. It always worked. For instance cell "N3" is a date field. As in my if/then statements, when nothing is entered, the delete key or the backspace key is pressed in "N3", "MM/DD/YY" should be in there in a lighter font color. Then when the date is entered the font color changes back to xlautomatic. How can I modify your code to follow thru when the delete or backspace key is pressed?

On another note, it just occurred to me that I will be using this code on approximately 25 sheets with different cell addresses so I'm going to have to keep the comparison if/then statements where they are unless you might have a better way?

Paul, as you can tell i'm not very good at VBA programming. I found this sub on the net which is very similar to yours above. I modified it and tried to bring the range over to the sub but I couldn't get it to work, it would only take a string. I'm only looking for it to act on one cell at a time as text is entered into that cell. That is why I tried (unsuccessfully) to use the activecell reference.

Thank you both for taking the time to look into this.
Gary

[SamT]

Gary,

The change event is triggered when a changed cell is left. IOW, Edit a cell and the event is not triggered while you are still in that cell

25 sheets requires 25 Worksheet_Change subs.

ThisWorkbook module returns both the sheet and the target.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sht
End Sub

There are (at least) two ways of looking at the problem. The simplest to comprehend, IMO, is the Skyscraper analogy, where each sheet is analogous to a floor in a highrise; They each do their own thing, but do share some common functions, like elevators and plumbing, or in your case, coloring a cell grey. The code in this thread (http://www.vbaexpress.com/forum/showthread.php?53037-Colour-Entire-Row-Base-on-the-Value-of-Two-Other-Cells), is based on that motif. Post # 16 demonstrates the idea. The cons of this method is that you wind up with a great many subs that are only slightly different. The pros are that it easy to write a sheet specific sub.

The alternative is the pyramid approach, wherein one Workbook_SheetChange sub hands off the range to one of 25 sheet specific subs, that then hand off to a relatively few lower level sheet specific subs that are all quite different, and several Generic subs, that do require a more complex decision making process than any sheet specific sub.

Without seeing your workbook, I can't make any recommendations.

[jonh]

Using MS Word...


Sub test()

SentenceCase Selection

End Sub

Sub SentenceCase(r As Range)
With CreateObject("Word.Document")
.Parent.Visible = True
With .Range(0, 0)
For Each c In r.Cells
.Text = c.Text
.Case = wdTitleSentence
c.Formula = .Text
Next
End With
.Parent.Quit False
End With
End Sub

[Paul_Hossler]

@ Paul

would this work

Dim Str As String
dim Rng As Range
Set Rng = Str.SpecialCells(xlCellTypeConstants, 2)


Doubt it since the parent of .SpecialCells has to be a Range, not a String



Excel Developer Reference
Range.SpecialCells Method

Returns a Range object that represents all the cells that match the specified type and value.

Syntax

expression.SpecialCells(Type, Value)
expression A variable that represents a Range object.



If there are no .SpecialCells thatmeet the critera, there's a 1004 error, so my 'style' is to trap the error and test for Nothing

[Paul_Hossler]

@jonh --



As in my if/then statements, when nothing is entered, the delete key or the backspace key is pressed in "N3", "MM/DD/YY" should be in there in a lighter font color. Then when the date is entered the font color changes back to xlautomatic. How can I modify your code to follow thru when the delete or backspace key is pressed?



If Range("N3").Value = "" Then
Range("N3").Value = "MM/DD/YY"
End If


If you hit [Delete] in N3, the cell is Empty. It looks the same to the user as a "" 0-length string, but not to VBA

Try something like this



If Len(Range("N3").Value) = 0 Then
Range("N3").Value = "MM/DD/YY"
End If

[zoom38]

Hi Paul this is what I've been using in the worksheet change code which activates when the delete key is pressed.


If Application.WorksheetFunction.Trim(Target.Value) = Empty Then
Select Case Target.address
Case "$B$38"
SentenceCase Target
Case "$N$3:$O$3", "$R$3", "$K$47"
CheckDates Target
Case "$N$4", "$R$4", "$R$47"
CheckHours Target
End Select
End If

This is the sub for the dates:


Sub CheckDates(rng As Range)

If rng.Value = "" Or IsDate(rng) = False Or IsEmpty(rng.Value) = True Or IsNull(rng.Value) = True Or Len(rng.Value) = 0 Then
rng.Value = "MM/DD/YY"
End If
If rng.Value <> "MM/DD/YY" Then
rng.Font.ColorIndex = 0
Else: rng.Font.ColorIndex = 15
End If

End Sub

It should meet the condition and pass through the first if/then statement but it doesn't. Would you know why it doesn't work?

Gary

[SamT]

Paul,




Sub SentenceCase(rng As String)

Set rngsource = Range(ActiveCell.address)

For Each cell In rngsource.SpecialCells(xlCellTypeConstants, 2)

[zoom38]

SamT I don't know what your post #13 is for. That's what I had in the original sub and it didn't work. With your help I am satisfied with the way it works now except the issues I ran into regarding the delete key. See my post #12. If I could get that to work, all would be well.

Gary

[Paul_Hossler]

After you hit the delete key, then IsEmpty(rng.Value) = True so it resets to MM/DD/YY, then does the Else in the second If

I'm guessing you'e looking for something along these lines. I did the colors just so I could see

Remember that Target can be a group or groups (aka Areas) of cells




Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Select Case Target.Address
Case "$B$38"
SentenceCase Target
Case "$N$3", "$O$3", "$R$3", "$K$47" '<<<<<<< not N3:O3
CheckDates Target
Case "$N$4", "$R$4", "$R$47"
CheckHours Target
End Select
Application.EnableEvents = True
End Sub
Sub SentenceCase(r As Range)
MsgBox r.Address
End Sub
Sub CheckHours(r As Range)
MsgBox r.Address
End Sub
Sub CheckDates(rng As Range)
Dim r As Range

Set r = rng.Cells(1, 1)

If IsDate(r.Value) Then
r.Interior.Color = vbGreen
r.Font.Color = vbWhite
Exit Sub
End If

If Len(r.Value) = 0 Or r.Value <> "MM/DD/YY" Then
r.Interior.Color = vbRed
r.Font.Color = vbBlack
r.Value = "MM/DD/YY"
End If
End Sub

[SamT]

Gary,

Post #13 was for Paul.

[Paul_Hossler]

Gary,

Post #13 was for Paul.

Thanks, but I think I'm missing what you were telling me.:think:

The only thing I see is a QUOTE with my 3 lines in it:dunno from #10

[zoom38]

Sam & Paul I apologize for the confusion. Sam I was just pointing out that the way you trimmed down my code was awesome and in working order except for the problem in post 12 and I didn't realize post 13 was for Paul.

Paul I used you code in post 15 which worked only partially, at first. It took me a while to figure it out because I was having issues due to merged cells. So to make your code work under all circumstances, the Select Case ranges had to be listed twice, as a single cell and as the merged cell like:


Case "$N$3", "$O$3", "$N$3:$O$3", "$R$3", "$R$3:$T$3", "$K$47", "$K$47:$O$47"


I think we go it. Thank you both for taking the time to help.
Gary