Good afternoon,
I have about 50,000 entries that I need to ensure that all of the names are formatted to the proper case. Is it possible to create a macro based on the =proper() text command to change the Names to the proper case to speed the process up?
Thank you in advance,
Jeff
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Hi Gary,
What a code!
However, when i run it, it only provides me with a box which contains the cell with the text in it, it doesn't change to the proper case. I would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
Thanks again,
Jeff
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
It's a bit of over-kill but useful.
'Passed back to the function from the UserForm
Public ChoiceForm_Value As Variant
'/===========================================/
Public Sub SelectCase()
'select a range and wrap UPPER, LOWER or PROPER
' function around it if it's text
Dim aryAnswer(1 To 4) As String
Dim rng As Range, rCell As Range
Dim strSelection As String
Dim strAnswer As String, strType As String
On Error Resume Next
aryAnswer(1) = "Upper Case"
aryAnswer(2) = "Lower Case"
aryAnswer(3) = "Proper Case"
aryAnswer(4) = "Cancel"
strSelection = Selection.Address
Set rng = Application.InputBox( _
prompt:="Select a range on this worksheet", _
Default:=strSelection, _
Type:=8)
strAnswer = udfGetSelection(aryAnswer)
If strAnswer = aryAnswer(4) Then
GoTo exit_Sub
End If
For Each rCell In rng
If TypeName(Application.Intersect(rCell, _
(ActiveSheet.UsedRange))) = "Nothing" Then
Exit For
End If
Select Case strAnswer
Case aryAnswer(1)
If _
WorksheetFunction.IsText(rCell) = _
True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Upper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Upper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(2)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Lower(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Lower(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case aryAnswer(3)
If WorksheetFunction.IsText(rCell) = True Then
If rCell.HasFormula = True Then
rCell.Formula = "=Proper(" & _
Right(rCell.Formula, _
Len(rCell.Formula) - 1) & ")"
Else
rCell.Formula = "=Proper(" & _
Chr(34) & rCell.value & Chr(34) & ")"
End If
End If
Case Else
Exit Sub
End Select
Next rCell
exit_Sub:
Set rng = Nothing
End Sub
'/===========================================/
Private Function udfGetSelection(aryStr() As String) _
As String
'Adds choices as defined in Ops array below
Dim aryChoices()
Dim iMaxChoices As Long, i As Long
Dim strTitle As String
Dim varChoiceSelected As Variant
On Error Resume Next
iMaxChoices = UBound(aryStr)
strTitle = "Change Case of Text..."
ReDim aryChoices(1 To iMaxChoices)
For i = 1 To iMaxChoices
aryChoices(i) = aryStr(i)
Next i
'Array of choices, default choice,
' title of form
varChoiceSelected = udfChoiceForm(aryChoices, _
iMaxChoices, strTitle)
' MsgBox aryChoices(varChoiceSelected)
udfGetSelection = aryChoices(varChoiceSelected)
End Function
'/===========================================/
Private Function udfChoiceForm(OpArray, Default, Title)
'based on a John Walkenbach program
'Creates a form with Custom Choices
'OpArray= array of choices
'Default= default choice, i.e. 1=1st choice in array
'Title = title of form
Dim TempForm As Object 'VBComponent
Dim NewOptionButton, NewCommandButton1, NewCommandButton2
Dim i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String
On Error Resume Next
'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
'Create the UserForm
'vbext_ct_MSForm
Set TempForm = _
ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
'Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = _
TempForm.Designer.Controls. _
Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
'/----------Add the OK button-------------
Set NewCommandButton1 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
'/-----------------------------------------
'/----------Add the Cancel button----------
Set NewCommandButton2 = _
TempForm.Designer.Controls. _
Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
'/-----------------------------------------
'---Add event-hander subs for the CommandButtons---
Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " ChoiceForm_Value = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) " & _
"= ""OptionButton"" Then" & vbCrLf
Code = Code & " If ctl Then " & _
"ChoiceForm_Value = ctl.Tag" & vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " ChoiceForm_Value=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
'/-----------------------------------------
With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With
'Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + _
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 34
End With
'Show the form
VBA.UserForms.Add(TempForm.name).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove _
VBComponent:=TempForm
'Pass the selected option back to
' the calling procedure
udfChoiceForm = ChoiceForm_Value
End Function
'/===========================================/
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Good afternoon,
> I have about 50,000 entries that I need to ensure that all of the names
> are formatted to the proper case. Is it possible to create a macro based
> on the =proper() text command to change the Names to the proper case to
> speed the process up?
>
> Thank you in advance,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
Select the range of cells that you want to change cases on.
Select "OK"
A box will appear with the options...Upper Case / Lower Case / Proper Case /
Cancel.
Cancel will be the default.
Select the 'Proper Case' button
Select "OK"
Your selected text should now be Proper Case.
HTH,
--
Gary Brown
gary_brown@ge_NOSPAM.com
If this post was helpful, please click the ''''Yes'''' button next to
''''Was this Post Helpfull to you?".
"JPriest" wrote:
>
> Hi Gary,
> What a code!
> However, when i run it, it only provides me with a box which contains
> the cell with the text in it, it doesn't change to the proper case. I
> would like the text to read Mr. Joe Smith instead of Mr. JOE SMITH.
>
> Thanks again,
> Jeff
>
>
> --
> JPriest
> ------------------------------------------------------------------------
> JPriest's Profile: http://www.excelforum.com/member.php...o&userid=24695
> View this thread: http://www.excelforum.com/showthread...hreadid=393931
>
>
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks