Center aligning largest number in selection by indenting - excel

Question

I have a longstanding formatting frustration. I often do this manually but doing it manually takes forever, and there has to be a way to do this with either a VBA macro, conditional formatting or a clever number format.
Below is my desired result. It has the following properties:
The largest number in the column (in this case the last number in the column, $103,420) is centered within the cell.
The largest number in the cell is not, however, center aligned, it is right indented until the value is centered.
All other numbers in the column are also right indented an equal amount. This is desirable because it lines up the ones place, tens place etc. in each number.
Negative numbers are denoted surrounded by parentheses.
The dollar sign is adjacent to the leftmost number.
Commas are included properly for numbers greater than 999.
This result was achieved by:
Applying the following number format:$#,##0_);($#,##0)_);$0_);#_)
Manually adjusting the right indent of the cell on the largest number to determine when it is roughly centered. If more space must be on one side or the other, the larger space is left on the left side of the number.
I attempted to apply a number format similar to the one used in response to this question.
Specifically my attempt at using this was to center align all cells using the following number format: $?,??0;($?,??0);
That produces the following close but not quite result below.
Thoughts on how I can address this? I'm imagining a macro that identifies the largest number in the selection, gets the number of digits in that number, the font size, the width of the column, does some computation yielding the desired right indent and then applies the right indent. I'm just not sure how to do that kind of computation.

Answer 1

'Select your data range, and run formatCells_Accounting(). The number formatting in the selected cells will widen to the cell with the longest value. Note, the macro does not work on values greater than 10^14 (not sure why.)
Sub formatCells_Accounting()
Dim rg As Range
Set rg = Selection
maxVal = Application.WorksheetFunction.Max(rg)
minVal = Application.WorksheetFunction.Min(rg)
If Abs(minVal) > maxVal Then
longest_ = minVal
Else
longest_ = maxVal
End If
lenLongest = Len(CStr(Round(longest_, 0)))
rg.NumberFormat = "_($" & addCommasToFormat(lenLongest) & "_);" & _
"_(($" & addCommasToFormat(lenLongest) & ");" & _
"_($" & addCommasToFormat(lenLongest - 1) & "0_);" & _
"_(#_)"
End Sub
Function addCommasToFormat(ByVal lenLongest) As String
str_ = String(lenLongest, "?")
new_str_ = ""
For i = 1 To Len(str_)
If i Mod 3 = 1 And i <> 1 Then
new_str_ = new_str_ & ",?"
Else
new_str_ = new_str_ & "?"
End If
Next
addCommasToFormat = StrReverse(new_str_)
End Function

Answer 2

Chris - your answer doesn't do what I was hoping for (your answer leaves space between the dollar sign and the "last" digit for numbers shorter than the longest number in the set)
However, your code was a helpful starting point for this solution I've come up with. The result is shown in the image below along with the inherent downside to this solution - running a formula on the numbers in the column after they've been formatted in this way results in a weird number format.
The only solution I can come up with that doesn't have the problem this solution does is, one that relies on estimating an indent, and applying it. That solution only works so long as the column width is not adjusted going forwards. If it is adjusted the macro would have to be re-run. Additionally, because the indent can only be increased by an increment of 1 (and nothing less), a macro that applied an indent would typically result in the largest number in the column not being exactly centered. Not a huge deal but my current solution doesn't have either of these problems and in my use case, these formats are being applied as the last step in the process of formatting a spreadsheet so additional calculations aren't likely to happen and if they do, the macro can simply be re-run as needed.
'Select your data range, and run formatCells_Accounting(). The number formatting in the selected cells will widen to the cell with the longest value. Note, the macro does not work on values greater than 10^14 (not sure why.)
Sub formatCells_Accounting()
Dim rg, thisColRange, rCell As Range
Dim maxVal, minVal, valueLen, longest_, lenLongest As Long
Set rg = Selection
'Center aligns all selected cells
rg.HorizontalAlignment = xlCenter
'Loops through each column in the selected range so that each column can have it's own max value
For Each thisColRange In rg.Columns
maxVal = Application.WorksheetFunction.Max(thisColRange)
minVal = Application.WorksheetFunction.Min(thisColRange)
'The longest number in the range may be the most negative
'This if section accounts for this scenario
If Abs(minVal) > maxVal Then
longest_ = minVal
Else
longest_ = maxVal
End If
'Gets the length of the longest value rounded to the ones place (aka length not including decimals)
lenLongest = Len(CStr(Round(Abs(longest_), 0)))
'Creates a number format for every cell
For Each rCell In thisColRange.Cells
'Gets the length of the value in the current cell
valueLen = Len(CStr(Round(Abs(rCell.Value), 0)))
rCell.NumberFormat = "_(" & addCommasDollarsToFormat(lenLongest, valueLen, rCell.Value) & "_);" & _
"_(" & addCommasDollarsToFormat(lenLongest, valueLen, rCell.Value) & ")_);" & _
"_(" & Left(addCommasDollarsToFormat(lenLongest, 1, rCell.Value), Len(addCommasDollarsToFormat(lenLongest, 1, rCell.Value)) - 1) & "0_);" & _
"_(#_)"
Next
Next
End Sub
Function addCommasDollarsToFormat(ByVal lenLongest, ByVal valueLen, ByVal cellVal) As String
Dim new_str_ As String
Dim i, j As Long
'Initializes empty strings
new_str_ = ""
nearlyFinishedString = ""
'Adds ? and , through the length of the value currently being formatted
For i = 1 To valueLen
If i Mod 3 = 1 And i <> 1 Then
new_str_ = new_str_ & ",?"
Else
new_str_ = new_str_ & "?"
End If
Next
If cellVal < 0 Then
new_str_ = new_str_ & "$("
Else
new_str_ = new_str_ & "$"
End If
For j = i To lenLongest
If j Mod 3 = 1 Then
new_str_ = new_str_ & ",?"
Else
new_str_ = new_str_ & "?"
End If
Next
addCommasDollarsToFormat = StrReverse(new_str_)
End Function
Solution visualized with the downside of the solution shown below it.