Macro to look for a pattern and replace with subscript (H2O --> Hsub2O)

[birkato]

I do a lot of spreadsheets where I type certainl chemical formulas over and over (CO2, H2O, CH4, N2O). When I finalize the report I am having to go into each instance and manually subscripting the number which takes forever. I am aware of a way to use autocorrect where I can type in something like CO/2 and get it to replace it with formatted text. That works, but it does me no good when someone else types the spreadsheet and does not have my autocorrect entries. I want to have a macro that will look for all instances of thes formulas within each cell and replace the numeral with a subscripted numeral. I found a macro online that will do this if the only text in the cell is the formula ("CO2" is the only text in the cell), but sometimes a cell will contain other things such as ("CO2 emission rate"). I have some basic knowlege of VBA but I don't know how to tackle this one. I assume I would need to have excel step through each string in each cell looking for these patterns, then somehow use the Font.Subscript commend to subscript it. Any ideas?

 

[JoeMo]

I've not used this macro, but it might be of interest:
Excel macro for subscripts, superscripts and common typos | oCoCarbon

 

[Marcelo Branco]

A very simple and limited solution - works just if there are no other numbers in the select cells, only those who are part of the chemicals.

**Try it on a copy of your workbook***

Sub aTest()
    Dim i As Long, rCell As Range
    
    For Each rCell In Selection
        For i = 1 To Len(rCell)
            If IsNumeric(Mid(rCell, i, 1)) Then rCell.Characters(Start:=i, Length:=1).Font.Subscript = True
        Next i
    Next rCell
        
End Sub

Select the cells of interest and run the macro.

M.

 

[István Hirsch]

This macro can do this, see: www.excelfindandformat.herobo.com and the attached youtube videos at https://www.youtube.com/user/valfor221

 

[birkato]

I've not used this macro, but it might be of interest:
Excel macro for subscripts, superscripts and common typos | oCoCarbon

Thanks! That is pretty much exactly what I was looking for. The only issue with it is that it CAN mess with formulas. For instance if I have a formula referring to cell H20 (such as =H20+A2), this macro will correct the formula string to H2O (letter O, not zero). This of course messes up the formula. It would be nice to limit the functionality to only replacing text. But, I can work aroudn this minor inconvenience because it saves me a lot of time.

 

[JoeMo]

Thanks! That is pretty much exactly what I was looking for. The only issue with it is that it CAN mess with formulas. For instance if I have a formula referring to cell H20 (such as =H20+A2), this macro will correct the formula string to H2O (letter O, not zero). This of course messes up the formula. It would be nice to limit the functionality to only replacing text. But, I can work aroudn this minor inconvenience because it saves me a lot of time.

You are welcome. Haven't looked at that macro in detail, but I imagine you can beat the problem you mention with an insertion of Range.SpecialCells(xlCellTypeConstants) method to limit the range of cells examined to non-formulaic cells.

 

[jamilm]

A very simple and limited solution - works just if there are no other numbers in the select cells, only those who are part of the chemicals.

**Try it on a copy of your workbook***


Sub aTest()
Dim i As Long, rCell As Range

For Each rCell In Selection
For i = 1 To Len(rCell)
If IsNumeric(Mid(rCell, i, 1)) Then rCell.Characters(Start:=i, Length:=1).Font.Subscript = True
Next i
Next rCell

End Sub


Select the cells of interest and run the macro.

M.

Thanks Marcelo.

This price of code is a good one.

 

[Marcelo Branco]

Thanks Marcelo.

This price of code is a good one.

Thank you but i think is possible to improve it a little bit.

Say you create a list like

H2O

H2SO4

HNO3

CH4

N2O

CO2

<tbody>
</tbody>

name the range, say, MyList


Before macro

CO2 emission rate

10 H2O blah 234

10blah H2SO4

HNO3

blah CH4 blah

N2O

<tbody>
</tbody>

Sub bTest()
    Dim i As Long, j As Long, rCell As Range, s As Variant, rngFound As Range
    
    For Each rCell In Selection
        s = Split(rCell & " ", " ")
        
        For j = 0 To UBound(s)
            Set rngFound = Range("MyList").Find(s(j), Lookat:=xlWhole, LookIn:=xlValues)
            
            If Not rngFound Is Nothing Then
                For i = 1 To Len(s(j))
                    If IsNumeric(Mid(rngFound, i, 1)) Then
                        rCell.Characters(Start:=i + InStr(rCell, s(j)) - 1, Length:=1).Font.Subscript = True
                    End If
                Next i
            End If
                    
        Next j
        
    Next rCell
        
End Sub

After macro

CO2 emission rate

10 H2O blah 234

10blah H2SO4

HNO3

blah CH4 blah

N2O

<tbody>
</tbody>

M.

 

[jamilm]

Thanks Marcelo. this one is even better.

Thank you but i think is possible to improve it a little bit.

Say you create a list like

H2O

H2SO4

HNO3

CH4

N2O

CO2

<tbody>
</tbody>

name the range, say, MyList


Before macro

CO2 emission rate

10 H2O blah 234

10blah H2SO4

HNO3

blah CH4 blah

N2O

<tbody>
</tbody>

Sub bTest()
    Dim i As Long, j As Long, rCell As Range, s As Variant, rngFound As Range
    
    For Each rCell In Selection
        s = Split(rCell & " ", " ")
        
        For j = 0 To UBound(s)
            Set rngFound = Range("MyList").Find(s(j), Lookat:=xlWhole, LookIn:=xlValues)
            
            If Not rngFound Is Nothing Then
                For i = 1 To Len(s(j))
                    If IsNumeric(Mid(rngFound, i, 1)) Then
                        rCell.Characters(Start:=i + InStr(rCell, s(j)) - 1, Length:=1).Font.Subscript = True
                    End If
                Next i
            End If
                    
        Next j
        
    Next rCell
        
End Sub

After macro

CO2 emission rate

10 H2O blah 234

10blah H2SO4

HNO3

blah CH4 blah

N2O

<tbody>
</tbody>

M.