CODEWITHSUNDEEP
excelvbafunctionstring-formatting
als0052
als0052

Reputation: 446

VBA Function to format parts of a string as subscripts

I have some text that I'm using to keep track of a bunch of variables in a long equation. Here's a short sample:

enter image description here

Requirements

I'm trying to make a VBA function that will take three cells as input and return what you see in the Term column (column D).

It will take the Coef cell and format it such that everything after the first character is subscripted, then do the same for the Variable cell.

If the value of Coef Value > 0, then the function should return the concatenation subscripted_Coef & "*" & subscripted_Variable (where subscripted_Coef and subscripted_Variable are pseudo-code); Otherwise it should return 0.

Problem

My issue is when I call the function in a cell (e.g. cell E3), I get an error message in Visual Basic:

enter image description here

Clicking OK highlights Public Function ConstructTerm(coef_cell, var_cell, coef_value) in yellow in Visual Basic.

I'm very new to VBA so at this point I am lost. I was able to make a macro to apply the proper formatting to a selection of cells with help from another StackOverflow post (didn't copy down the share link though), but I'm having trouble converting that into a function. I won't post that macro code for sake of length of this post, but I can if needed.

Cell E2 shows an IF-statement that I used before to get the required output, but it doesn't apply the subscript formatting that I want. It shows the logic I'm wanting though, with the exception of the ISBLANK() portion (I can do without that).

Code so far

Public Function ConstructTerm(coef_cell, var_cell, coef_value)
' =================================================================================================
' For a selection of cells combine the coefficient and variable parts to make the term for that
' contribution to the larger equation. This function will later be called to create the entire 
' equation when a button is pressed in the Excel Worksheet. 
'
' INPUTS:
'   - coef_cell: (String) The cell containing the string for the coefficient part
'   - var_cell: (String) The cell containing the string for the variable part
'   - coef_value: (Double) The value of the coefficient. If value = 0 then return 0 instead of the
'                  concatenated string
'
' OUTPUTS:
'   - (String) The concatenated string in the format <coef_cell>*<var_cell> with the proper subscripts
'      on both the coef_cell and var_cell.
' =================================================================================================
Dim s1 As String
Dim s2 As String

s1 = make_subscript(coef_cell)
s2 = make_subscript(var_cell)
If coef_value = 0 Then
    ConstructTerm = 0
Else
    ConstructTerm = s1 & "*" & s2
End If

End Function


Public Function MakeSubscript(cell_str)
' =================================================================================================
' Make all characters after the 1st character in a string subscripted. This function is a variation
' on the subprocedure named make_subscript()
'
' INPUTS:
'   - cell_str: (String) The string that needs to have all characters after the first character subscripted
'
' OUTPUTS:
'   - (String) The contents of the string with all the characters after the first subscripted
' =================================================================================================
With cell_str.Characters(Start:=1, Length:=1).Font
    .Subscript = False
End With
With cell_str.Characters(Start:=2).Font
    .Subscript = True
End With
make_subscript = cell_str
End Function

Update

Here is the code that I ended up with to do what I wanted. Thanks to Ron Rosenfeld for his solution

Edit: Totally forgot about the ISBLANK portion of the original code, not a huge deal. It updates automatically so if a change is made then the change is reflected automatically.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' =================================================================================================
' Use event code to automatically apply the proper formatting to the 'Term' column.
'
' When any of the cells in columns for coefficient, variable, or coefficient value are changed the
' cell to the right of column coefficient value is updated with the string representation of the
' product of coef and variable cells for that row; the numbers will be properly subscripted.
'
' -------------------------------------------------------------------------------------------------
' *************************************************************************************************
' * WARNING: ASSUMES A RIDIG LAYOUT OF THE DATA! DO NOT ATTEMPT TO USE ON ANYTHING OTHER THAN     *
' *          workbook_name.xlsm WORKSHEET [worksheet name].                               *
' *************************************************************************************************
' -------------------------------------------------------------------------------------------------
'
' This code must be placed in the worksheet code module of the worksheet containing the target
' data. For more info on worksheet code see https://www.contextures.com/xlvba01.html
' -------------------------------------------------------------------------------------------------
'
' TODO
' -  Need to have the cell retain whatever border/shading formatting it had before the change to
'    one of the three columns occurs. Low priority though.
' - When changing values in one of the three columns, the values entered don't appear in the cell
'   as they are being entered... but they show up in the formula bar properly. Weird...
' -------------------------------------------------------------------------------------------------
'
' Code source: https://stackoverflow.com/a/64807624/11895567
'
' Minor modifications made for compatability with production worksheet instead of test worksheet
' and other minor code formatting changes to suit my preferences. (, on 11-12-2020)
'
' Created on 11-12-2020
' =================================================================================================
Dim rngToCheck As Range
Dim C As Range
Dim s1 As String
Dim s2 As String
Dim sRes As String
Dim I As Long

Dim coef_col As Integer
Dim coef_val_col As Integer
Dim variable_col As Integer

coef_col = 5                ' Coef column is Column E
variable_col = coef_col + 1 ' Variable column is Column F
coef_val_col = coef_col + 2 ' Coef Value column is Column G

' determine last filled in row of column E, and expand to E:G
Set rngToCheck = Range(Cells(1, coef_col), Cells(Rows.Count, coef_col).End(xlUp)).Resize(columnsize:=3)
If Not Intersect(rngToCheck, Target) Is Nothing Then    ' Is the changed cell within the rngToCheck
    Application.EnableEvents = False                    ' Disable event checking so as not to retrigger
                                                        '     when writing results
    For Each C In Intersect(rngToCheck, Target)         ' subscript the appropriate characters
        With C
            If Cells(C.Row, coef_val_col) <> 0 Then
                s1 = Cells(C.Row, coef_col)
                s2 = Cells(C.Row, variable_col)
                sRes = s1 & "*" & s2
                With Cells(C.Row, coef_val_col + 1)
                    .ClearFormats
                    .Value = sRes
                    For I = 1 To Len(sRes)
                        If IsNumeric(Mid(sRes, I, 1)) Then
                            .Characters(I, 1).Font.Subscript = True
                        End If
                    Next I
                End With
            End If
        End With
    Next C
End If
Application.EnableEvents = True 're-enable event code; if macro exits prematurely, this won't happen
End Sub

Upvotes: 0

Views: 1360

Answers (1)

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60224

You can possibly use event code to accomplish your goals.

For example, install this module in the worksheet code module of the worksheet where your table is located.

  • The code is triggered on a change in cells in the first three columns

  • Then, depending on the contents of column 3, it will do the subscripting according to a scheme which subscripts digits (you may want to change that)

  • my code is not as well annotated as yours, but you should be able to get the picture and make any appropriate changes

  • Also, there are some additions that should be made

    • If you delete the contents of column 1, it gets removed from rngToCheck, so might want to blank everything below rngToCheck as a first step
    • might need a different algorithm for determining subscripted characters

Edit to blank cell if 0 or blank in column 3

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngToCheck As Range, C As Range
    Dim s1 As String, s2 As String, sRes As String
    Dim I As Long
    
    
'determine last filled in row of column A, and expand to A:C
Set rngToCheck = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)

'Is the changed cell within the rngToCheck
If Not Intersect(rngToCheck, Target) Is Nothing Then

    'Disable event checking so as not to retrigger when writing results
    Application.EnableEvents = False
    
    'subscript the appropriate characters
    For Each C In Intersect(rngToCheck, Target)
        With C
            If Cells(C.Row, 3) <> 0 Then
                s1 = Cells(C.Row, 1)
                s2 = Cells(C.Row, 2)
                sRes = s1 & "*" & s2
                
                With Cells(C.Row, 4)
                    .ClearFormats
                    .Value = sRes
                    For I = 1 To Len(sRes)
                        If IsNumeric(Mid(sRes, I, 1)) Then
                            .Characters(I, 1).Font.Subscript = True
                        End If
                    Next I
                End With
            Else
                Cells(C.Row, 4) = 0
            End If
        End With
    Next C
End If

're-enable event code
'if macro exits prematurely, this won't happen
Application.EnableEvents = True

End Sub

Upvotes: 1

Related Questions