VBA - changing subscript state in cells that contain _some_ subscripts

xeniorn

New Member
Joined
Feb 5, 2015
Messages
2
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 -> AB2C
AB2C -> AB2C
AB2C -> AB2C
AB2C -> AB2C

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?

Code:
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

Well-known Member
Joined
Aug 19, 2003
Messages
5,615
Hello,

Does this work as required?

Code:
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.
 
Last edited:

xeniorn

New Member
Joined
Feb 5, 2015
Messages
2
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

New Member
Joined
Sep 28, 2010
Messages
15
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

Code:
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
 

Forum statistics

Threads
1,081,702
Messages
5,360,738
Members
400,594
Latest member
Frothingslosh

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top