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?

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?