none
Cambria font problem and advice for sizing text in cells RRS feed

  • Question

  • When I use Cambria font the size of numbers is bigger than size of words. Is there any vba code which can make them of desired size?
    Another situation when I want numbers and words particular size in a cell, How can I achieve?
    Please help.
    Regards.
    drsantoshsinghrathore
    Tuesday, September 10, 2019 4:07 PM

Answers

  • d,
    re:  auto size numeric font size

    Here you go...

    '---
    Sub AdjustNumericFontSizeR1()
    'Nothing Left to Lose - September 2019
    On Error GoTo WrongSize
    Dim lngLength As Long
    Dim MySize     As Long
    Dim Num        As Long
    Dim MyChar     As String
    Dim rngAll     As Excel.Range
    Dim rngCell    As Excel.Range

    Set rngAll = Excel.Selection.Cells
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each rngCell In rngAll
    If rngCell.Value Like "*#*" Then
    MySize = Application.WorksheetFunction.Max(rngCell.Font.Size - 4, 4) '<<< NEW CODE LINE
    lngLength = VBA.Len(rngCell.Value)
    For Num = 1 To lngLength
    MyChar = VBA.Mid$(rngCell.Value, Num, 1)
    If MyChar Like "#" Then
    rngCell.Characters(Num, 1).Font.Size = MySize
    End If
    Next 'Num
    End If
    Next 'rngCell

    WrongSize:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set rngAll = Nothing
    End Sub
    '---

    Please mark this topic as answered.

    Thursday, September 12, 2019 5:39 PM

All replies

  • To: d

    Re:  adjusting cell font size
      On the Ribbon | Home (tab) | Font (group) are buttons(icons) to adjust font size in cells.

    Re: adjusting numeric font size in cells.
      Following is VBA code to set the font size for all numeric characters in the selection.
      NOTE:  Do not select entire columns or entire rows.

    '---
    Sub AdjustNumericFontSize()
    'Nothing Left to Lose - September 2019
    On Error GoTo WrongSize
    Dim lngLength As Long
    Dim MySize     As Long
    Dim Num        As Long
    Dim MyChar   As String
    Dim rngAll     As Excel.Range
    Dim rngCell   As Excel.Range

    MySize = 9               '<<<<< Specify size of numeric characters
    Set rngAll = Excel.Selection.Cells
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each rngCell In rngAll
    If rngCell.Value Like "*#*" Then
    lngLength = VBA.Len(rngCell.Value)
    For Num = 1 To lngLength
    MyChar = VBA.Mid$(rngCell.Value, Num, 1)
    If MyChar Like "#" Then
    rngCell.Characters(Num, 1).Font.Size = MySize
    End If
    Next 'Num
    End If
    Next 'rngCell

    WrongSize:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set rngAll = Nothing
    End Sub
    '---

    Interesting free stuff here...
    http://www.mediafire.com/folder/lto3hbhyq0hcf/Documents

    Wednesday, September 11, 2019 12:08 AM
  • Hi,

    Just checking in to see if the information of Nothing Left to Lose was helpful. Please let us know if you would like further assistance.

    Regards,

    Emi Zhang


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.

    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Office 2019.

    Wednesday, September 11, 2019 6:42 AM
    Moderator
  • Thank you very much Nothing Left to Lose for your kindness,


    Can I make it a routine that if my word font size is 16 then numbers in that cell becomes 12 automatically and if word size is 20 then number size becomes 16.


    Regards
    Wednesday, September 11, 2019 3:59 PM
  • d,
    re:  alternate font sizes for numbers

    Checking each cell for font size will increase processing time.
    Using a particular cell on the worksheet to check for font size, just before the code starts, would be better.

    Either way, what to do if the existing font size is not 16 or 20?
    One can simply subtract 4 from the existing font size, but I doubt that would apply if the existing font size was 8.

    Just in case, please note that you can specify the numeric font size near the top of the code, in this line...
      MySize = 9
    Wednesday, September 11, 2019 5:00 PM
  • Thank you very much Nothing Left to Lose for your kindness,

    True. But if it is possible to make the size of number 4 lesser than that of word would be a good choice. Because in hat situation it do automatically what is desired.

    Regards.
    Thursday, September 12, 2019 4:35 PM
  • d,
    re:  auto size numeric font size

    Here you go...

    '---
    Sub AdjustNumericFontSizeR1()
    'Nothing Left to Lose - September 2019
    On Error GoTo WrongSize
    Dim lngLength As Long
    Dim MySize     As Long
    Dim Num        As Long
    Dim MyChar     As String
    Dim rngAll     As Excel.Range
    Dim rngCell    As Excel.Range

    Set rngAll = Excel.Selection.Cells
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For Each rngCell In rngAll
    If rngCell.Value Like "*#*" Then
    MySize = Application.WorksheetFunction.Max(rngCell.Font.Size - 4, 4) '<<< NEW CODE LINE
    lngLength = VBA.Len(rngCell.Value)
    For Num = 1 To lngLength
    MyChar = VBA.Mid$(rngCell.Value, Num, 1)
    If MyChar Like "#" Then
    rngCell.Characters(Num, 1).Font.Size = MySize
    End If
    Next 'Num
    End If
    Next 'rngCell

    WrongSize:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set rngAll = Nothing
    End Sub
    '---

    Please mark this topic as answered.

    Thursday, September 12, 2019 5:39 PM
  • Thank you Nothing Left to Lose,

    It do the job twice and reduces the size number 8. I wanted it to be 4 lesser with comparison to word font size.

    Regards
    Friday, September 20, 2019 7:55 AM
  • To: d,
    re:  revision R2

    [EDITED]
    Revised code shown below...
    '---
    Sub AdjustNumericFontSizeR2()
    'Nothing Left to Lose - September 2019
    'NOTE:  Do not select entire columns or entire rows.
    On Error GoTo WrongSize
    Dim lngLength As Long
    Dim Num       As Long
    Dim MySize    As Long
    Dim TempSize  As Long
    Dim MyChar    As String
    Dim rngAll    As Excel.Range
    Dim rngCell   As Excel.Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set rngAll = Excel.Selection.Cells
    MySize = 4

    For Each rngCell In rngAll
    If rngCell.Value Like "*#*" And Not VBA.IsNumeric(rngCell.Value) Then
    lngLength = VBA.Len(rngCell.Value)
    For Num = 1 To lngLength
    TempSize = rngCell.Characters(Num, 1).Font.Size
    If TempSize > MySize Then MySize = TempSize
    Next 'Num

    MySize = Application.WorksheetFunction.Max(MySize - 4, 4)
    For Num = 1 To lngLength
    MyChar = VBA.Mid$(rngCell.Value, Num, 1)
    If MyChar Like "#" Then
    rngCell.Characters(Num, 1).Font.Size = MySize
    End If
    Next 'Num
    End If
    MySize = 4
    Next 'rngCell

    WrongSize:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set rngAll = Nothing
    If Err.Number > 0 Then
    MsgBox "Error " & Err.Number & " - " & Err.Description & "  ", vbCritical, "Adjust Font Size "
    End If
    End Sub
    '---

    Please mark as answered.


    Saturday, September 21, 2019 2:25 PM