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

B

birkato

New Member
Joined
Aug 15, 2013
Messages
8
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?
 
Sort by date Sort by votes
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***

Code: 
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.
 
Upvote 0
JoeMo said:
I've not used this macro, but it might be of interest:
Excel macro for subscripts, superscripts and common typos | oCoCarbon
Click to expand...

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.
 
Upvote 0
birkato said:
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.
Click to expand...
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.
 
Upvote 0
Marcelo Branco said:
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.
Click to expand...

Thanks Marcelo.

This price of code is a good one.
 
Upvote 0
jamilm said:
Thanks Marcelo.

This price of code is a good one.
Click to expand...


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

Say you create a list like

[TABLE="width: 48"]
<tbody>[TR]
[TD="class: xl65, width: 64, bgcolor: transparent"]H2O
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]H2SO4
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]HNO3
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]CH4
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]N2O
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]CO2
[/TD]
[/TR]
</tbody>[/TABLE]

name the range, say, MyList


Before macro
[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD="width: 125, bgcolor: transparent"]CO2 emission rate
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10 H2O blah 234
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10blah H2SO4
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]HNO3
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]blah CH4 blah
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]N2O
[/TD]
[/TR]
</tbody>[/TABLE]


Code: 
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
[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD="width: 125, bgcolor: transparent"]CO2 emission rate
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10 H2O blah 234
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10blah H2SO4
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]HNO3
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]blah CH4 blah
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]N2O
[/TD]
[/TR]
</tbody>[/TABLE]

M.
 
Upvote 0
Thanks Marcelo. this one is even better.


Marcelo Branco said:
Thank you but i think is possible to improve it a little bit.

Say you create a list like

[TABLE="width: 48"]
<tbody>[TR]
[TD="class: xl65, width: 64, bgcolor: transparent"]H2O
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]H2SO4
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]HNO3
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]CH4
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]N2O
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent"]CO2
[/TD]
[/TR]
</tbody>[/TABLE]

name the range, say, MyList


Before macro
[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD="width: 125, bgcolor: transparent"]CO2 emission rate
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10 H2O blah 234
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10blah H2SO4
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]HNO3
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]blah CH4 blah
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]N2O
[/TD]
[/TR]
</tbody>[/TABLE]


Code: 
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
[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD="width: 125, bgcolor: transparent"]CO2 emission rate
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10 H2O blah 234
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]10blah H2SO4
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]HNO3
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]blah CH4 blah
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]N2O
[/TD]
[/TR]
</tbody>[/TABLE]

M.
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Subscript out of range vba error 9 excel, but it works on other laptops
2
Replies
15
Views
1K
smozgur
smozgur
N
  • Solved
Deleting Specific Spaces & Subscripting Issues
Replies
9
Views
854
Peter_SSs
Peter_SSs
C
  • Solved
I need a formula to a) find the first numeral in a text string b) remove that numeral and all the characters after that numeral
Replies
3
Views
164
Peter_SSs
Peter_SSs
Cliffork
  • Solved
Print to PDF Macro, or possibly more
2 3
Replies
21
Views
541
mumps
mumps
B
  • Question Question
Macro to look text in the right column and set a variable character count
Replies
2
Views
153
Peter_SSs
Peter_SSs

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top