Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Macro for changing text to Proper Case
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 |
#2
|
|||
|
|||
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 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 |
#3
|
|||
|
|||
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 |
#4
|
|||
|
|||
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 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
reminder notifications in a column | Excel Discussion (Misc queries) | |||
Macro to convert text to date | Excel Worksheet Functions | |||
Dynamic Formulas with Dynamic Ranges | Excel Worksheet Functions | |||
Macro or Function to make text size to suite text Length? | Excel Discussion (Misc queries) | |||
Identifying the Active Fill Color | Excel Discussion (Misc queries) |