One single character to upper case
Correction!
My previous macro (Quick_McName_Adjustment) contains a problem.
Use the macro above :
'-----------------8<----------------------------
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub Quick_McName_Adjustment2()
Dim lngStart As Long
Dim strRef As String
lngStart = GetTickCount
Application.ScreenUpdating = False
strRef = Selection.Range("A1").Address(False, False)
Selection.Cells.Offset(, 1).Insert xlToRight
With Selection.Cells.Offset(, 1)
..FormulaLocal = "=IF(LEFT(" & strRef & ";2)=""Mc"";" _
& "SUBSTITUTE(" & strRef & ";RIGHT(" & strRef & ";" _
& "LEN(" & strRef & ")-2);PROPER(RIGHT(" & strRef & ";" _
& "LEN(" & strRef & ")-2)));" & strRef & ")"
..Copy
Selection.PasteSpecial (xlPasteValues)
..Delete xlToLeft
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Debug.Print "Quick_McName_Adjustment2: " _
& GetTickCount - lngStart & " msec"
End Sub
'-----------------8<----------------------------
Sorry for my carelessness.
--
John
--
Ο χρήστης "John_John" *γγραψε:
Hi all!
You can use the power of Excel within your code.
For example:
If the range with the names contains only a single column,
try the macro below.
'-----------------8<----------------------------
Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub Quick_McName_Adjustment()
Dim lngStart As Long
Dim strRef As String
lngStart = GetTickCount
Application.ScreenUpdating = False
strRef = Selection.Range("A1").Address(False, False)
With Selection.Cells.Offset(, 1)
.Insert xlToRight
.FormulaLocal = "=IF(LEFT(" & strRef & ";2)=""Mc"";" _
& "SUBSTITUTE(" & strRef & ";RIGHT(" & strRef & ";" _
& "LEN(" & strRef & ")-2);PROPER(RIGHT(" & strRef & ";" _
& "LEN(" & strRef & ")-2)));" & strRef & ")"
.Copy
Selection.PasteSpecial (xlPasteValues)
.Delete xlToLeft
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Debug.Print "Quick_McName_Adjustment: " & GetTickCount - lngStart & "
msec"
End Sub
'-----------------8<----------------------------
Enable the Immediate window to see the results.
In my system it needs 62 msec for the range "A1:A10000".
Sorry for my English.
I do not speak english very well. :-(
John
Ο χρήστης " *γγραψε:
Thanks, Rick. Of course, I should have realised the amended text
would need putting back into the cell!
And thanks too, David, but I really did need this in a macro rather
than a formula.
Steve
|