How to arrange a string to display - excel

Question

How can I generate a string using vba that lets certain characters line up. As an example, lets say the strings generated over two rows are as follows:
"96 x $219.00 = $21,024.00"
"-8 x 45.00 = -360.00"
I want spaces added to the left of the rightmost number to have the "=" signs line up.
I also want spaces added to the left of the middle number to have the "x" character line up.
These strings are generated from a vba function.
I'm restricted to using Times-Roman Size 8 (company requirement, no negotiating)
Also, the string is to be right justified, in case someone is concerned.
After trying to extract the character width using Columns.ColumnWidth and comparing the widths of repeating a character say 10 and then 11 times (I tried other sets of numbers than these), then building a function to break down a string into characters and sum them, padding as described, the characters still don't line up. There should be a way to do this in vba. There are too many tables to fix by hand. Previous posting discussing just padding characters, fail to address how they are displayed.

Answer 1

Aligning text by inserting spaces is a terrible idea (word processing 101). Plus it is modifying the data, and as a user I would complain if I enter a=b into a cell and all of a sudden it is a=b.
Aligning text for a non-proportional font by adding spaces is impossible. You can only have a "best attempt" which approximately aligns them.
There is no build-in function in Excel (or VBA) to achieve this.
So, I did the following just for fun. Take it or leave it.
(1) There is no build in function for the text width of a string in VBA. If you google around, you can find different attempts, but one suggestion is rather easy to understand: Put a label on a user form, format it to the font you are interested in (eg Times New Roman, 8pt, Non-Bold, Non-Italic) and set properties AutoSize = True and .WordWrap = False.
When assigning any text to this label, it changes its size and you can read the width of it. Now this doesn't return the exact width of the text as the label uses some extra pixels to the left and right - but for our purposes we can ignore that.
So create a userform and put a label on it. Don't worry, you don't need to show the form, the resize of the label will be done even if the form is not displayed.
Now put the following code into a regular module:
Function GetTextWidth(s As String) As Double
Static f As UserForm1
If f Is Nothing Then Set f = New UserForm1
With f.Label1
.Font.Name = "Times New Roman"
.Font.Size = 8
.Font.Italic = False
.Font.Bold = False
.AutoSize = True
.WordWrap = False
.Caption = s
GetTextWidth = .Width
End With
End Function
(2)
Now we need to loop over all data (all cells of your range), split the text into the part left of the equation sign and the part right of it using split, calculate the word length for the left part and remember the length of the widest string.
(3)
Now we loop another time over all the data, again split the text, take the left part and add spaces to the left until the width is larger (or equal) than the max length we just calculated. If we reach the point, we check if this "nearer" to the max length or if we should go for one space left.
Code for Step 2 and 3:
Sub alignTextrange(r As Range, Optional alignChar As String = "=")
Const SpacesAroundAlignChar = 1
' First: Find widest string to the left of alignChar
Dim maxWidth As Double, currWidth As Double, prevWidth As Double
Dim leftWord As String
Dim cell As Range, tokens() As String
For Each cell In r
tokens = Split(cell.Value, alignChar)
If UBound(tokens) = 1 Then ' 2 pieces (like a = b)
leftWord = Trim(tokens(0))
currWidth = GetTextWidth(leftWord)
If currWidth > maxWidth Then maxWidth = currWidth
End If
Next
Debug.Print "Max: " & maxWidth
If maxWidth = 0 Then Exit Sub
' And now: Align all other cells to the one with the widest left string
For Each cell In r
tokens = Split(cell.Value, alignChar)
If UBound(tokens) = 1 Then ' 2 pieces (like a = b)
leftWord = Trim(tokens(0))
prevWidth = GetTextWidth(leftWord)
Dim i As Long
For i = 1 To 100
currWidth = GetTextWidth(Space(i) & leftWord)
Dim spacesNeeded As Long
If currWidth >= maxWidth Then
If maxWidth - prevWidth < currWidth - maxWidth Then
spacesNeeded = i - 1
Else
spacesNeeded = i
End If
cell = Space(spacesNeeded) & leftWord _
& Space(SpacesAroundAlignChar) & alignChar _
& Space(SpacesAroundAlignChar) & Trim(tokens(1))
Exit For
End If
prevWidth = currWidth
Next
End If
Next
End Sub
Of course there is room for improvement, like reading/writing the data into an array or to precalculate the width of several spaces, this should only show the rabbit hole you need to go down.
If this is not good enough then your only option is to go for spaces with a smaller font, but then it gets much more complicated. Or convince your bossed to get rid of this ugly font (or look for a new job).
(alignted is obviously a typo, too lazy to correct in my sheet and redo the screenshots).