Modify format of part of cell (2002)

Topic

New Reply

Anyone know how to create a macro or VBA to modify part of a cell format ?
I very often need to use Greek symbols and subscripts within a cell for writing mathematical equations.
(Example: tmin = MAX (a, t, tn) where the min is a subscript, and the a should be the Greek alpha)
What I do is F2 the cell to edit it, select the text to change using the keyboard arrows (the mouse is too slow), then use the mouse to select the font drop-down list, type “s” to get near to the Symbols font to get the Greek equivalent of the letter selected. Then I use the keyboard to move to the desired subscript text, select it, move my hand back to the mouse to click on the “Font point-size decrease” button twice, and while I’m there, click on the Italics button. And so on, and so on…
I’ve tried writing a macro, but it only applies to the full cell content. Once in Edit mode, it doesn’t activate.
Any ideas ???

Reply | Quote

Replies

Kevin,

If the equation is just for display, you could place a textbox on the worksheet and type out your equation, drag the box to where you want it, then right click on the textbox border and select no fill and no line.

Maybe not the best solution….but it works.

Brent

Reply | Quote

There is another workaround. Have a spare workbook with the target formats in it. Use Ctrl + C and Ctrl + V to Copy and Paste into the Formula Bar. The Font Property in VBA applies to a Range – minimum size an entire cell (as you have found out). HTH

Reply | Quote

Hi Unkamunka,

<>

No it doesn’t.

Activecell.characters(5,10).Font.Size=24
Sets the size of characters 5 to 14 to 24

Unfortunately one cannot run any code while editing a cell.

But one could use special characters to delimit the text that needs special formatting, e.g. _this_ causes the word This to be subscript, ^this^ to make it superscript, etcetera. Then use a macro that searches for these special characters, removes them and formats the area they enclosed appropriately.
Beats all the clicking, selecting and dragging the original poster experiences.

I believe there is an insert symbol utility out there somewhere. maybe at:

http://www.cpearson.com

Reply | Quote

On the example you provided the following should convert the min part to subscript for each cell in the selection. Actually what it does is work on characters 2 to 4 inclusive regardless of what they are. You may be able to adapt it for your needs.

Dim oCell As Range
    For Each oCell In Selection
        With oCell.Characters(Start:=2, Length:=3).Font
            .Subscript = True
        End With
    Next oCell

Andrew C

Reply | Quote

Good point, Andrew. On that basis, should he not be able to set up a toolbar with a fair number of his desired options linked into macros?

Reply | Quote

He could, and using Instr and InstrRev might be able to introduce variables as to the actual characters to be operated on. Plenty of scope for experimentation at least.

Andrew

Reply | Quote

It’s not quite as easy as that unfortunately. Because the ‘min’ part is just an example, and the position of the letters to be subscripted or converted to Greek is never the same from one line to the next.
I think the solution for me would be to have a short-cut key for each of the 3 types of conversion.
One exists already. I can use Ctrl-I for converting the subscript to italics.
I need another for reducing the size of the subscript to 8,
and a third for converting font to Symbol.
With those 3 shortcuts, I could convert all I need without touching the mouse.
That’s the only way to do it when the text to convert is never in the same place.

But how can I associate a shortcut key with an existing button? The button to reduce the font size by one point is already on my tool bar, but doesn’t have an associated short-cut (I think).

Reply | Quote

If you read Andrew’s second post more carefully – the same point was made this morning by Jan Karel – you will see that you can set up a Macro using the Instr and InstrRev functions. (Look in the VBA Help files – the functions will search for “_” – or whatever delimiter you choose.) You then attach that macro to toolbar icons (Customise|Attach Macro) – linking the macro to a keyboard shortcut. Someone else may come up with some code before I get the chance. HTH

Reply | Quote

Here it is.

Option Explicit
Dim iStart() As Integer
Dim iEnd() As Integer
Dim iCount As Integer
Dim sChar() As String
Const sChars As String = “_^%&#”

Sub ChangeLocalFormats()
Dim sCellTxt As String
Dim sTemp As String
Dim iLoop As Integer
iCount = 1
ReDim sChar(1)
ReDim iStart(1)
ReDim iEnd(1)
sCellTxt = ActiveCell.Value
If Left(ActiveCell.Formula, 1) = “=” Then Exit Sub

For iLoop = 1 To Len(sCellTxt)
sTemp = Mid(sCellTxt, iLoop, 1)
If iLoop > Len(sCellTxt) Then Exit For
If InStr(sChars, sTemp) > 0 And Not sTemp = “” Then
ReDim Preserve sChar(iCount)
ReDim Preserve iStart(iCount)
ReDim Preserve iEnd(iCount)
sChar(iCount) = sTemp
GetStartEnd sCellTxt, sTemp
ActiveCell.Replace sTemp, “”, xlPart, , True
sCellTxt = ActiveCell.Value
iCount = iCount + 1
iLoop = 0
End If
Next
For iLoop = 1 To iCount – 1
If iStart(iLoop) > 0 Then
With ActiveCell.Characters(iStart(iLoop), iEnd(iLoop) – iStart(iLoop))
Select Case InStr(sChars, sChar(iLoop))
Case 1
.Font.Subscript = True
Case 2
.Font.Superscript = True
Case 3
.Font.Italic = True
Case 4
.Font.Bold = True
Case 5
.Font.Name = “Symbol”
End Select
End With
End If
Next
End Sub
Sub GetStartEnd(sCellTxt As String, sChar As String)
iStart(iCount) = InStr(1, sCellTxt, sChar)
iEnd(iCount) = InStr(iStart(iCount) + 1, sCellTxt, sChar) – 1
End Sub

So in this:

_ sets subscript
^ sets superscript
% sets italic
& sets Bold
# sets Symbol font

Test it on this text:

^Super^_sub_%italic%&bold&#greek#

You can even nest formatting characters:

^super&boldsuper&^

Reply | Quote

Wow !!!!!!!!
What an effort !!
I pasted it into a VB module of my Personal.xls, and applied it to a custom button.
It works perfectly! Genial stuff. I am so amazed that I can’t work. I’ll have to take a few minutes off.
Thanks – great effort.

Reply | Quote

It took me about one hour to put it together.
Great you like it.

Reply | Quote

Brilliant!

Reply | Quote

Jan, sometimes I have more than one place in the equation where I need a subscript or a Greek symbol.
Only the first of each seems to get processed.
Example: f_r_ + #a# + S_n_ + #b#

If I edit a second time to get the second ocurrence of each type right, the first occurrence gets undone.

Reply | Quote

Oh yeah, I see why, the clue is in the line with the replace method, which replaces all occurrances of the chartacter in question. Bad design .

No time now to develop a workaround though.

Reply | Quote

Kevin,

I thought this would be an interesting project, but Jan had a solution before I had a chance to try anything. Anyway, since you still needed an improvement to the code, I (borrowing liberally from Jan ) wrote this code which should detect and format all instances of a pair of formatting codes.

Sub MyAttempt()
Dim iChar() As Long
Dim sCodeChar As String
Dim sTestChar As String
Dim sWork As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim Index As Long
Dim TextLength As Long
Dim bFlag As Boolean
Const sChars As String = "_^%&#"

If Left(ActiveCell.Formula, 1) = "=" Then Exit Sub

'Find number of pairs of formatting codes and redim array
TextLength = Len(ActiveCell.Value)
For i = 1 To TextLength
    If InStr(sChars, Mid(ActiveCell.Value, i, 1)) > 0 Then j = j + 1
Next i
If j  2  j / 2 Then
    MsgBox "Code pair is incomplete. Halt formatting procedure"
    Exit Sub
End If
j = j / 2 + 1
ReDim iChar(j, 3)

Index = 1  'initialize

'loop through each formatting character
For i = 1 To 5
    'remove all code chars except the relevant code character from text string
    'i is the index number for the formatting code
    sWork = ""
    sCodeChar = Mid(sChars, i, 1)
    For j = 1 To TextLength
        sTestChar = Mid(ActiveCell.Value, j, 1)
        If InStr(sChars, sTestChar) = 0 Then 'the char is not a formatting char
            sWork = sWork + sTestChar
        ElseIf sTestChar = sCodeChar Then  'the char is the relevant formatting char
            sWork = sWork + sTestChar
        End If
    Next j
    
    'Save the starting and ending positions for each actual segment of text to
    'be formatted and the formating character's index.  Use k to count the instances
    'of the formatting character.
    k = 0
    For j = 1 To Len(sWork)
        If Mid(sWork, j, 1) = sCodeChar Then
            If Not bFlag Then 'First instance in a pair of codes
                iChar(Index, 1) = j - k
                bFlag = True
                k = k + 1
            Else              'Second instance in a pair of codes
                iChar(Index, 2) = j - k - 1
                bFlag = False
                k = k + 1
                iChar(Index, 3) = i
                Index = Index + 1
            End If
        End If
    Next j
Next i

'Remove all formatting characters from active cell contents
sWork = ""
For i = 1 To Len(ActiveCell.Value)
    If InStr(sChars, Mid(ActiveCell.Value, i, 1)) = 0 Then
        sWork = sWork + Mid(ActiveCell.Value, i, 1)
    End If
Next i
ActiveCell.Value = sWork

'Apply formatting
For i = 1 To Index - 1
    With ActiveCell.Characters(iChar(i, 1), iChar(i, 2) - iChar(i, 1) + 1)
        Select Case iChar(i, 3)
            Case 1 ' Underscore
                .Font.Subscript = True
            Case 2 ' ^
                .Font.Superscript = True
            Case 3 ' %
                .Font.Italic = True
            Case 4 ' & fixed per JohnBF
                .Font.Bold = True
            Case 5 ' # Greek
                .Font.Name = "Symbol"
         End Select
    End With
Next i

End Sub

Reply | Quote

Overjoyed. I didn’t expect to get such a quick solution to this problem which has been irking me for about a year now. You guys are the gurus of the gurus.
I am completely satisfied with this now.
But, if you want to go one step further, and only if you want to (because I’m happy we got this far and it is completely functional for me, but there may be others out there who find this useful too):
When you add another term to an equation, with a subscript say, all the previous formatting gets undone.
I know I know I know, we’re getting too complicated here, and it’s really not necessary.

Thanks a million Jan and kjktoo. Wonderful job. You have really impressed me.

Reply | Quote

Sorry, but the “next step” is beyond my knowledge. Perhaps Jan, a true excel guru, can help.

– edited –
What you might consider is keeping a copy of the original formula with the formatting codes in a nearby cell and modify that cell with your new term, copy to the desired location and run the macro, then.

Ken

Reply | Quote

Very nice, KJToo.

FWIW I wrote myself an “entry” msgbox as a reminder of what the macro does and what the codes are:

If MsgBox(“Underscore_ = Subscript,” & vbLf & “Caret^ = Superscript,” & vbLf & _
“Percent% = Italic,” & vbLf & “Ampersand& = Bold,” & vbLf & “Pound # = Greek Symbol” _
& vbLf & vbLf & “Continue?”, vbYesNoCancel) vbYes Then Exit Sub

I put it after the other errorchecking routines.

Reply | Quote

I guess the easiest would be to keep a copy of the preformatted string, which you can edit and format again later on. It would be a lot of work to code one that reverses the process.

Reply | Quote

<>

You’re very welcome to it. Good improvements.

Reply | Quote

that was an awesome piece of code. added to my bag of tricks.

FYI-Another solution was posted in post #88824 last Nov using a slightly different approach with a slightly different problem. It actually started out as a very different problem but the originator asked a 2nd question that was similar to this one. I’ve saved that one too.

Fred

Reply | Quote