Solved: Convert to Propercase Selectively

[CaptRon]

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]

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]

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]

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]

My friend, this works perfectly. Very nice. Thanks again.

Ron

[CaptRon]

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]

You could use a control array, but that is just as neat an approach (IMO)

[CaptRon]

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]

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]

Thank you very much. I'll put this to good use.

Ron