Deleting Specific Spaces & Subscripting Issues

[Naut05]

Hi there,

I have a column with a mix of letters and numbers in each cell and I need one specific number to be subscript, even when there are other instances of that number present (e.g. I need the first 2 in H2-2 subscript but everything else normal case). I tried to target the first 2 by subscripting "H2" with Font.Subscript = True and then running another code with Font.Subscript = False for the "H" but that didn't do anything (no error, it just didn't change anything on the sheet). I tried to go around that by placing spaces on either side of the target 2 and then targeting " 2 " for the subscript but I'm now trying to delete those two spaces only, leaving the other spaces in the cell.

I've also tried subscripting at a specific character position but the number of characters and the specific character position of the spaces and the subscripted number vary from cell to cell.

The whole cell's contents would be something like "7.13 (1H, s, H *2* -20a);" with the asterixes indicating the subscript.

From what I've read, you can trim all, trailing or leading spaces using Trim and its variants, but that doesn't really fit my case. Is there anyway to delete those two spaces while leaving all the others? Maybe using Replace? They're the two right most spaces in the cell if that helps but they're not on the end of the string.

Or is there a way to better target the subscripting of the number?

Code I used to subscript the " 2 ": (not mine, I found it on a forum or site that used it to italicize a certain character, I repurposed it for subscripting instead.)

Sub SubscriptAttempt3
Dim c As Range, n As Long, m As Long
  For Each c In Range("AG4", Range("AG" & Rows.Count).End(3))
    n = InStr(1, c.Value, " 2 ", vbTextCompare)
    If n > 0 Then
      m = InStr(1, c.Value, "-", vbTextCompare)
      If m = 0 Then m = Len(c.Value) Else m = m - n
      c.Characters(Start:=n, Length:=m).Font.Subscript = True
    End If
  Next c
End Sub

I used the same code to try and remove the subscript on the H by changing it to the following, but it did nothing to the sheet.

Sub SubscriptAttempt3
Dim c As Range, n As Long, m As Long
  For Each c In Range("AG4", Range("AG" & Rows.Count).End(3))
    n = InStr(1, c.Value, "H", vbTextCompare)
    If n > 0 Then
      m = InStr(1, c.Value, "2", vbTextCompare)
      If m = 0 Then m = Len(c.Value) Else m = m - n
      c.Characters(Start:=n, Length:=m).Font.Subscript = False
    End If
  Next c
End Sub

Many thanks in advance

 

[Georgiboy]

Would be good to see some more examples of the strings in question to see if there is an easier method to extract.

Below is one example but there will be many more methods depending on the data:

Book1
	A	B
1	7.13 (1H, s, H2 -20a);	2
Sheet1

Cell Formulas
Range	Formula
B1	B1	=LET( r,FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[translate(., 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789', '')='']"), --RIGHT(r,LEN(r)-1))

 

[Naut05]

Would be good to see some more examples of the strings in question to see if there is an easier method to extract.

Below is one example but there will be many more methods depending on the data:

Book1
	A	B
1	7.13 (1H, s, H2 -20a);	2
Sheet1

Cell Formulas
Range	Formula
B1	B1	=LET( r,FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[translate(., 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789', '')='']"), --RIGHT(r,LEN(r)-1))

Thank you for your reply, here's a few more examples. The subscripted number will likely range from 1 to 9

12.01–10.98 (2H, m, H 2 -9);

5.19 (1H, dd, J = 6.0, 1.5 Hz, H 1 -20a);

5.15 (1H, s, H 1 -20b);

4.51 (2H, AB q, J = 17.2 Hz, H 2 -22);

4.01 (2H, d, J = 5.4 Hz, H 2 -17);

7.13–7.00 (1H, m, H 1 -18);

3.56 (3H, dt, J = 11.0, 1.5 Hz, H 3 -15);

 

[Georgiboy]

Is the space already there before the letter or has that been put in with code?

 

[Georgiboy]

Maybe the below will help with either:

Book1
	A	B
1	12.01–10.98 (2H, m, H2 -9);	2
2	5.19 (1H, dd, J = 6.0, 1.5 Hz, H1 -20a);	1
3	5.15 (1H, s, H1 -20b);	1
4	4.51 (2H, AB q, J = 17.2 Hz, H2 -22);	2
5	4.01 (2H, d, J = 5.4 Hz, H2 -17);	2
6	7.13–7.00 (1H, m, H1 -18);	1
7	3.56 (3H, dt, J = 11.0, 1.5 Hz, H3 -15);	3
8
9
10	12.01–10.98 (2H, m, H 2 -9);	2
11	5.19 (1H, dd, J = 6.0, 1.5 Hz, H 1 -20a);	1
12	5.15 (1H, s, H 1 -20b);	1
13	4.51 (2H, AB q, J = 17.2 Hz, H 2 -22);	2
14	4.01 (2H, d, J = 5.4 Hz, H 2 -17);	2
15	7.13–7.00 (1H, m, H 1 -18);	1
16	3.56 (3H, dt, J = 11.0, 1.5 Hz, H 3 -15);	3
Sheet1

Cell Formulas
Range	Formula
B1:B7	B1	=LET(v,TEXTBEFORE(TAKE(TEXTSPLIT(A1,", "),,-1),"-"),--RIGHT(v,LEN(v)-1))
B10:B16	B10	=LET(v,TEXTBEFORE(TAKE(TEXTSPLIT(A10,", "),,-1),"-"),--TEXTAFTER(v," "))

 

[Naut05]

Would be good to see some more examples of the strings in question to see if there is an easier method to extract.

Below is one example but there will be many more methods depending on the data:

Book1
	A	B
1	7.13 (1H, s, H2 -20a);	2
Sheet1

Cell Formulas
Range	Formula
B1	B1	=LET( r,FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[translate(., 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789', '')='']"), --RIGHT(r,LEN(r)-1))

Maybe the below will help with either:

Book1
	A	B
1	12.01–10.98 (2H, m, H2 -9);	2
2	5.19 (1H, dd, J = 6.0, 1.5 Hz, H1 -20a);	1
3	5.15 (1H, s, H1 -20b);	1
4	4.51 (2H, AB q, J = 17.2 Hz, H2 -22);	2
5	4.01 (2H, d, J = 5.4 Hz, H2 -17);	2
6	7.13–7.00 (1H, m, H1 -18);	1
7	3.56 (3H, dt, J = 11.0, 1.5 Hz, H3 -15);	3
8
9
10	12.01–10.98 (2H, m, H 2 -9);	2
11	5.19 (1H, dd, J = 6.0, 1.5 Hz, H 1 -20a);	1
12	5.15 (1H, s, H 1 -20b);	1
13	4.51 (2H, AB q, J = 17.2 Hz, H 2 -22);	2
14	4.01 (2H, d, J = 5.4 Hz, H 2 -17);	2
15	7.13–7.00 (1H, m, H 1 -18);	1
16	3.56 (3H, dt, J = 11.0, 1.5 Hz, H 3 -15);	3
Sheet1

Cell Formulas
Range	Formula
B1:B7	B1	=LET(v,TEXTBEFORE(TAKE(TEXTSPLIT(A1,", "),,-1),"-"),--RIGHT(v,LEN(v)-1))
B10:B16	B10	=LET(v,TEXTBEFORE(TAKE(TEXTSPLIT(A10,", "),,-1),"-"),--TEXTAFTER(v," "))

Neither of those worked, unfortunately.

For the first formula you gave for 1 example, it just outputs 0, and the second formula doesn't do anything to the sheet. I think it might be because excel is weird when it comes to subscript? - when removed anything on either side with things like Find and Replace it undoes the subscript too. The final string needs to end up in a word doc anyway, so I've left the spaces until they're in Word and then using Find and Replace and ^c to replace it with just the subscripted number.

Thank you for your help, though.

 

[Peter_SSs]

Welcome to the MrExcel board!

Is the space already there before the letter or has that been put in with code?

We did not get an answer to that so for the moment I have assumed that the original data does not have the space before (or after) the value to be subscripted. It is also unclear to me if the only letter that will have a value to be subscripted is "H".

In any case try this with a copy of your data to see if it is headed in the right direction. Its aim is to subscript any digits that immediately follow any upper case letter.

Sub Make_Subscripts()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "[A-Z]\d+"
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      For Each M In RX.Execute(a(i, 1))
        .Cells(i).Characters(M.firstindex + 2, Len(M) - 1).Font.Subscript = True
      Next M
    Next i
  End With
End Sub

My sample data

Naut05.xlsm
	A
1
2	12.01–10.98 (2H, m, H2-9);
3	5.19 (1H, dd, J = 6.0, 1.5 Hz, H1-20a);
4	5.15 (1H, s, H1-20b);
5	4.51 (2H, AB q, J = 17.2 Hz, H2-22);
6	4.01 (2H, d, J = 5.4 Hz, H2-17);
7	7.13–7.00 (1H, m, H1-18);
8	3.56 (3H, dt, J = 11.0, 1.5 Hz, H3-15);
9	4.01 (2H3, d, J = 5.4 Hz, H32 -17);
10	4.01 (2BW333, d, J = 5.4 Hz, X32 -17);
Sheet4

Result of the above code

 

[Georgiboy]

I misinterpreted the question...

 

[Naut05]

Welcome to the MrExcel board!


We did not get an answer to that so for the moment I have assumed that the original data does not have the space before (or after) the value to be subscripted. It is also unclear to me if the only letter that will have a value to be subscripted is "H".

In any case try this with a copy of your data to see if it is headed in the right direction. Its aim is to subscript any digits that immediately follow any upper case letter.

Sub Make_Subscripts()
  Dim RX As Object, M As Object
  Dim a As Variant
  Dim i As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "[A-Z]\d+"
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    For i = 1 To UBound(a)
      For Each M In RX.Execute(a(i, 1))
        .Cells(i).Characters(M.firstindex + 2, Len(M) - 1).Font.Subscript = True
      Next M
    Next i
  End With
End Sub

My sample data

Naut05.xlsm
	A
1
2	12.01–10.98 (2H, m, H2-9);
3	5.19 (1H, dd, J = 6.0, 1.5 Hz, H1-20a);
4	5.15 (1H, s, H1-20b);
5	4.51 (2H, AB q, J = 17.2 Hz, H2-22);
6	4.01 (2H, d, J = 5.4 Hz, H2-17);
7	7.13–7.00 (1H, m, H1-18);
8	3.56 (3H, dt, J = 11.0, 1.5 Hz, H3-15);
9	4.01 (2H3, d, J = 5.4 Hz, H32 -17);
10	4.01 (2BW333, d, J = 5.4 Hz, X32 -17);
Sheet4

Result of the above code

View attachment 90547

My apologies, I should have clarified in my previous replies, the spaces were not part of the original data, as you assumed. They were added in my attempt to target that specific number.
And yes, only the number following the uppercase H needs to be subscripted, and it will always be an uppercase H.

Your code worked brilliantly! Thank you so much.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

only the number following the uppercase H needs to be subscripted, and it will always be an uppercase H.

If is was possible that the data contained another letter followed by a number (that should not be subscripted) then the 'pattern' line should be changed to

RX.Pattern = "H\d+"

Example with this changed pattern line

Naut05.xlsm
	A
1
2	12.01–10.98 (Z2, m, H2-9);
3	5.19 (1H, dd, J = 6.0, 1.5 Hz, H1-20a);
Sheet3

Result (the Z2 part is not altered)