VBA automatically shrink text size if result of formula in a cell hits 4 digits or more

[akramer08]

I have a sheet that I enter numbers in all day in columns R:Y and there are formulas in cells I:L that change upon the data entry. I just need a bit of code that will shrink the size of the text in a cell if the result of the formula hits 4 digits or more. I never select or enter anything in the cells with the formula.


I have a code already that uses target address to run and add certain numbers together and if the new code needs to be added to it that would be fine.

Private Sub Worksheet_Change(ByVal Target As Range)
Cella = Target.Offset(0, -1).Value
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("S:S").Column Or .Column = Range("U:U").Column Or .Column = Range("W:W").Column Or .Column = Range("Y:Y").Column _
Or .Column = Range("AU:AU").Column Or .Column = Range("AW:AW").Column Or .Column = Range("AY:AY").Column Or .Column = Range("BA:BA").Column Then
Target.Offset(0, -1) = Target + Cella
End If
End With
On Error Resume Next
Next Cell
End Sub

 

[JoeMo]

This module goes into the sheet - not a standard module. Right-click the sheet tab and choose "View Code" then copy/paste below code into the white space in the VB Editor window.

Private Sub Worksheet_Calculate()
Dim R As Range
On Error Resume Next
Set R = Columns("I:L").SpecialCells(xlFormulas)
For Each a In R.Areas
    For Each c In a
        If Len(c.Value) >= 4 Then c.ShrinkToFit = True
    Next c
Next a
End Sub

 

[akramer08]

JoeMo,

Sorry about the late reply. That works pretty well other than it runs a little slow. Is there any way to add that to the macro I have posted above using an offset? It could check just the offset cell this way it might run smoother. The offset would work as follows: If data is entered in Col S, check Col I. Enter in Col U, check Col J. I could figure out the rest from there.

 

[JoeMo]

The code is already limiting the number of cells that need to be checked to those cells containing formulas. What you propose requires still more checks that will likely slow things down more. Try adding this line at the start of the sub (right after the Dim statement:

Application.ScreenUpdating = False