VBA - changing subscript state in cells that contain _some_ subscripts

[xeniorn]

The task here is rather simple: Make all the numbers in all the cells in the selected range go to subscript, and all the others to lose the subscript. The code works brilliantly when the original text has no subscripts or if all the characters in the cells are in subscript. When some of the characters are in subscript, it is only possible to set some more characters to .Subscript=True, but not to make some .Subscript=False - i.e. to remove them from subscript.

Here are the outcomes I get without the workaround:

AB2C -> AB₂C
A_B2C -> A_B2C
_AB2C -> AB₂C
AB_2C -> AB_2C

I managed to work around this by adding two lines that first set everything to subscript and then remove subscript from everything - this works in this case, but in other cases I will need some of the formatting to be preserved while I switch the formatting of some other target substrings. I can always store the existing formatting in an temporary array or something like this, but somehow it seems to me strange that there isn't a more simple solution to this...

Any ideas why I cannot do cell.Font.Substring = False on such partially formatted cells? And how could I go around this in an elegant manner?

Sub DoTheFormat()


Dim List As Range, cell As Range
Dim Formula As String
Dim i As Integer


Set List = Application.Selection
Dim tmp As String

'**************************for debugging
List.Font.Subscript = True   
List.Font.Subscript = False
'**************************/for debugging   


For Each cell In List
    For i = 1 To Len(cell)
        tmp = Mid(cell, i, 1)
        If tmp Like "#" Then
            cell.Characters(i, 1).Font.Subscript = True
        Else
            cell.Characters(i, 1).Font.Subscript = False
        End If
    Next i
Next cell




End Sub

 

[onlyadrafter]

Hello,

Does this work as required?

Sub SUBSCRIPT()
    Application.ScreenUpdating = False
    For MY_ROWS = 1 To Range("A" & Rows.Count).End(xlUp).Row
            Range("A" & MY_ROWS).Font.SUBSCRIPT = True
            Range("A" & MY_ROWS).Font.SUBSCRIPT = False
            For MY_CELL = 1 To Len(Range("A" & MY_ROWS).Value)
                If IsNumeric(Mid(Range("A" & MY_ROWS).Value, MY_CELL, 1)) Then
                    Range("A" & MY_ROWS).Characters(MY_CELL, 1).Font.SUBSCRIPT = True
                Else
                    Range("A" & MY_ROWS).Characters(MY_CELL, 1).Font.SUBSCRIPT = False
                End If
            Next MY_CELL
    Next MY_ROWS
    Application.ScreenUpdating = True
End Sub

Sorry, just re-read your post and noticed that I have created exactly the same as you did, except mine works on Col A only. Didn't read all of your post.

Guess you will need to tell us what other formatting you have.

 

[xeniorn]

It's only subscripts / superscripts so far, no other formatting. But I would like to be able to keep the existing superscripts and subscripts where they need to be, and correct wrong subscripts where necessary. The second part seems to be the problem - I am not able to set .Subscript to False for a particular character if the cell has .Characters both with True and False .Subscript.

So, to repeat - the question is: Why can't I set Characters(SomeCharacterNumber,1).Subscript = False? They simply stay True when I attempt this for a cell with a mix of normal and subscripted text. Can anyone reproduce this problem?

 

[profray]

Hi xeniorn,
I reproduced your problem and tried some other ideas with little luck.
1. I replaced the like condtional with an instr string function with the reference string as "0123456789" so that if the tmp variable you have is a numeral character instr would return a value of 1 to 10. If its a letter or other symbol, it returns 0. Then the subscript conditional statement is based on whether the result is =0 or not. I could watch it during debug and the instr worked fine, but it still would not change the subscript. I tried switching the individual character to true and false for subscript, but that made it worse!!. I'll plug away on this for another hour but I don't have much hope. Anyway, here is my code for my trials

Sub DoTheFormat()
'This routine does no better than the original
'If you want to use the workaround, uncomment the
' List.Font.Subscript lines below
Dim List As Range, cell As Range
Dim Formula As String
Dim i As Integer


Set List = Application.Selection
Dim tmp As String
Dim NumberList As String
'**************************for debugging
List.Font.Subscript = True
List.Font.Subscript = False
'**************************/for debugging
NumberList = "0123456789"

For Each cell In List
    For i = 1 To Len(cell)
        tmp = Mid(cell, i, 1)
        'cell.Characters(i, 1).Font.Subscript = True
        'cell.Characters(i, 1).Font.Subscript = False
        Iresult = InStr(1, NumberList, tmp, vbTextCompare)
  '      If tmp Like "#" Then
  '          cell.Characters(i, 1).Font.Subscript = True
  '      Else
  '          cell.Characters(i, 1).Font.Subscript = False
        If Iresult = 0 Then     'If tmp is a letter
             cell.Characters(i, 1).Font.Subscript = False
          Else
             cell.Characters(i, 1).Font.Subscript = True
        End If
    Next i
Next cell
End Sub