View Full Version : Solved: Convert to Propercase Selectively
CaptRon
06-21-2010, 11:21 PM
I am looking for some code to apply to a data table containing mostly text.
The text is entered with a userform and the one doing the entering prefers to type all uppercase. The boss prefers to see proper case.
Using a macro that converts all the text to proper case is pretty straight forward. However, some words need to be lower case, some should be all uppercase, and the rest proper case.
I have prepared a pair of lists on an ajacent sheet for the uppercase words and strictly lower case words.
What code can I use to convert the range of text in the table to the appropriate case?
Cross-posted: http://www.mrexcel.com/forum/showthread.php?t=475886
Thanks,
Ron
Bob Phillips
06-22-2010, 12:09 AM
Option Explicit
Private mcCancel As Boolean
Private mcUCWords As Variant
Private mcLCWords As Variant
Private Sub TextBox1_AfterUpdate()
Dim aryWords
Dim idxWord As Long
Dim i As Long, j As Long
With Me.TextBox1
.Text = Application.Proper(.Text)
aryWords = Split(.Text, " ")
For i = LBound(aryWords) To UBound(aryWords)
For j = LBound(mcUCWords) To UBound(mcUCWords)
If LCase(aryWords(i)) = LCase(mcUCWords(j)) Then
aryWords(i) = UCase(aryWords(i))
Exit For
End If
Next j
For j = LBound(mcLCWords) To UBound(mcLCWords)
If LCase(aryWords(i)) = LCase(mcLCWords(j)) Then
aryWords(i) = LCase(aryWords(i))
Exit For
End If
Next j
Next i
.Text = Join(aryWords, " ")
MsgBox .Text
End With
End Sub
CaptRon
06-22-2010, 11:20 AM
XLD,
I loaded this code into the userform then enter text via the userform.
I get a run-time error 13 - Type Mismatch at this line:
For j = LBound(mcUCWords) To UBound(mcUCWords)
When I clear the error, my Excel 2003 crashes.
I've obviously done something wrong. Please help.
Ron
Bob Phillips
06-22-2010, 11:37 AM
Sorry Ron, I missed a bit.
Private Sub UserForm_Activate()
mcUCWords = Application.Transpose(Worksheets("data").Range("UCWords"))
mcLCWords = Application.Transpose(Worksheets("data").Range("LCWords"))
End Sub
THis assumed named ranges of UCWords and LCWords holding the selected words.
CaptRon
06-22-2010, 02:42 PM
My friend, this works perfectly. Very nice. Thanks again.
Ron
CaptRon
06-22-2010, 03:53 PM
Just as a followup, I couldn't find a way to create an array of controls in the userform so I just called a single macro (referring to Me.ActiveControl) when each control is updated. Thanks for all your help.
Private Sub tbxVendor_AfterUpdate()
AdjustTextCase
End Sub
Private Sub tbxItem_AfterUpdate()
AdjustTextCase
End Sub
Private Sub cbxCat_AfterUpdate()
AdjustTextCase
End Sub
Sub AdjustTextCase()
Dim aryWords
Dim idxWord As Long
Dim i As Long, j As Long
With Me.ActiveControl
.Text = Application.Proper(.Text)
aryWords = Split(.Text, " ")
For i = LBound(aryWords) To UBound(aryWords)
For j = LBound(mcUCWords) To UBound(mcUCWords)
If LCase(aryWords(i)) = LCase(mcUCWords(j)) Then
aryWords(i) = UCase(aryWords(i))
Exit For
End If
Next j
For j = LBound(mcLCWords) To UBound(mcLCWords)
If LCase(aryWords(i)) = LCase(mcLCWords(j)) Then
aryWords(i) = LCase(aryWords(i))
Exit For
End If
Next j
Next i
.Text = Join(aryWords, " ")
'MsgBox .Text
End With
End Sub
Ron
Bob Phillips
06-22-2010, 04:08 PM
You could use a control array, but that is just as neat an approach (IMO)
CaptRon
06-24-2010, 12:32 PM
XLD,
In this case, I only have 3 textboxes in the userform so I am happy enough with calling a macro in this fashion. However, I have other workbooks with many more controls.
How do you create an array of controls? Somewhere I read that it could be done in VB but not with VBA. Obviously, not true.
Ron
Bob Phillips
06-24-2010, 01:44 PM
Like this.
In the form
Dim mcolEvents As Collection
Private Sub UserForm_Initialize()
Dim cTBEvents As clsUserFormEvents
Dim i As Long
Set mcolEvents = New Collection
For i = 1 To 3
Set cTBEvents = New clsUserFormEvents
Set cTBEvents.mTBGroup = Me.Controls("TextBox" & i)
mcolEvents.Add cTBEvents
Next i
End Sub
and then create a class module called clsUserFormEvents with this code
Option Explicit
Private mcUCWords As Variant
Private mcLCWords As Variant
Public WithEvents mTBGroup As MSForms.TextBox
Private Sub Class_Initialize()
mcUCWords = Application.Transpose(Worksheets("data").Range("UCWords"))
mcLCWords = Application.Transpose(Worksheets("data").Range("LCWords"))
End Sub
Private Sub mTBGroup_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 9 Or KeyCode = 13 Then
Call AdjustTextCase(mTBGroup)
End If
End Sub
Sub AdjustTextCase(ByRef TB As MSForms.TextBox)
Dim aryWords
Dim idxWord As Long
Dim i As Long, j As Long
With TB
.Text = Application.Proper(.Text)
aryWords = Split(.Text, " ")
For i = LBound(aryWords) To UBound(aryWords)
For j = LBound(mcUCWords) To UBound(mcUCWords)
If LCase(aryWords(i)) = LCase(mcUCWords(j)) Then
aryWords(i) = UCase(aryWords(i))
Exit For
End If
Next j
For j = LBound(mcLCWords) To UBound(mcLCWords)
If LCase(aryWords(i)) = LCase(mcLCWords(j)) Then
aryWords(i) = LCase(aryWords(i))
Exit For
End If
Next j
Next i
.Text = Join(aryWords, " ")
'MsgBox .Text
End With
End Sub
CaptRon
06-24-2010, 03:50 PM
Thank you very much. I'll put this to good use.
Ron
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.