Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Kevin
 
Posts: n/a
Default 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   Report Post  
Gary Brown
 
Posts: n/a
Default

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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to change the color of all series in an excel chart in one go. Marielle Charts and Charting in Excel 2 May 3rd 23 07:45 PM
How do you globally change format from upper to lower case In Mic. RCC User Excel Discussion (Misc queries) 2 May 30th 07 06:02 AM
How do I change the default date format in an Excel Footer Burki Setting up and Configuration of Excel 1 February 4th 05 03:15 AM
how to change default comment format in excel (2000) superiorparties Excel Discussion (Misc queries) 1 February 3rd 05 01:43 AM
How to change the color of all series in an excel chart in one go. Mz2 Charts and Charting in Excel 1 January 20th 05 02:07 AM


All times are GMT +1. The time now is 01:43 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"