Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Make Change Case in Excel a format rather than formula
In Excel if you need to change case you have to create a formula in a
different column to change the case then copy it back to the original cells in the new format. Can this be put in as a menu item to where you could highlight a group of cells, right click and choose change case then be prompted for Lower or Upper? |
#2
|
|||
|
|||
Kevin,
(1) Put the code below in a module in your 'Personal.xls'. According to John Walkenbach (www.j-walk.com): "The Personal Macro Workbook... If you create some VBA macros that you find particularly useful, you may want to store these routines on your Personal Macro Workbook. This is a workbook (Personal.xls) that is stored in your XLStart directory. Whenever you start Excel, this workbook is loaded. It's a hidden workbook, so it's out of your way. When you record a macro, one of your options is to record it to your Personal Macro Workbook. The Personal.xls file doesn't exist until you record a macro to it." (2) Create a button on your toolbar for this macro. (A) Right-click up in the toolbar area (at the top of the screen). (B) Select CUSTOMIZE / COMMANDS (C) Under CATEGORIES, select MACROS (D) Under COMMANDS, drag the Happy Face up to your toolbar area and let go where you want it. (3) Right-click on the Happy Face (A) Change the 'Name' to something like 'Case Change' (B) Select ASSIGN MACRO... (C) Select 'PERSONAL.XLS!SelectCase' (D) Select OK then CLOSE Hope this helps, Gary Brown Start copying the code on the next line........ 'Passed back to the function from the UserForm Public GetChoice_RET_VAL As Variant '/===========================================/ Public Sub SelectCase() 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 = Wksht_or_Msgbox(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 Wksht_or_Msgbox(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 = GetChoice(aryChoices, _ iMaxChoices, strTitle) ' MsgBox aryChoices(varChoiceSelected) Wksht_or_Msgbox = _ aryChoices(varChoiceSelected) End Function '/===========================================/ Private Function GetChoice(OpArray, Default, Title) 'based on a John Walkenbach program '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 & " GetChoice_RET_VAL = False" & vbCrLf Code = Code & " For Each ctl In Me.Controls" & _ vbCrLf Code = Code & " If TypeName(ctl) " & _ "= ""OptionButton"" Then" & vbCrLf Code = Code & " If ctl Then " & _ "GetChoice_RET_VAL = 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 & " GetChoice_RET_VAL=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 GetChoice = GetChoice_RET_VAL End Function '/===========================================/ "Kevin" wrote: In Excel if you need to change case you have to create a formula in a different column to change the case then copy it back to the original cells in the new format. Can this be put in as a menu item to where you could highlight a group of cells, right click and choose change case then be prompted for Lower or Upper? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to change the color of all series in an excel chart in one go. | Charts and Charting in Excel | |||
How do you globally change format from upper to lower case In Mic. | Excel Discussion (Misc queries) | |||
How do I change the default date format in an Excel Footer | Setting up and Configuration of Excel | |||
how to change default comment format in excel (2000) | Excel Discussion (Misc queries) | |||
How to change the color of all series in an excel chart in one go. | Charts and Charting in Excel |