• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to cause numbers 70 thru 90 in Column C to become bold and red.

Eloise T

Active Member
In a TVs model number, the first two consecutive numbers reference the diagonal screen size.

In Column C, (TV Model) (see attachment and below pictures), I am using Conditional Formatting to cause certain cells to become highlighted, but also (in the same cells) need numbers 70 thru 90 to become red and bold. See pictures below:

A sample of before: What it needs to look like after:

upload_2017-6-29_14-39-28.png

Elsewhere, I use the following two formulas to first remove spaces and dashes (Column J) and then figure out the "number" representing the TV Model's screen size (Column K).

COLUMN J →→ =SUBSTITUTE(SUBSTITUTE(C7," ",""),"-","")

COLUMN K →→ =IFERROR(--MID($M7,MIN(IFERROR(FIND(ROW($10:$99),M7),"")),2),"--")


I hope my pictures and explanation was clear. Bottom line: I need VBA to color red and boldface the model number's screen size for sizes 70 thru 90 in Column C on each Tab.
 

Attachments

  • Chandoo - Column C needing red bold numbers.xlsm
    439 KB · Views: 8
Last edited:
The following is a Macro Recording I created.

How can I automate this so it seeks and changes all TV model number's screen size for sizes 70 thru 90 in Column C on each Tab to red and boldface?
Code:
With ActiveCell.Characters(Start:=2, Length:=2).Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
 
Using your formulae you can do something along these lines; run the code after selecting the cells in column C that you want to change:
Code:
Sub blah()
For Each cll In Selection.Cells  'Range("C3:C43").Cells
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(70:90)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  With .Characters(Start:=x, Length:=2).Font
  .FontStyle = "Bold"
  .Color = -16776961
  End With
  End If
  End With
Next cll
End Sub
It's basic and there's no error-checking.
Note also the ROW(70:90) honouring the '70 thru 90' requirement.
 
Last edited:
update:
The previous offering would also highlight numbers form 70 to 90 anywhere in the model number so here's a correction:
Code:
Sub blah()
For Each cll In Selection.Cells  'Range("C3:C43").Cells
  With cll
    x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
    If x > 0 Then
      y = CLng(Mid(cll.Value, x, 2))
      If y >= 70 And y <= 90 Then
        With .Characters(Start:=x, Length:=2).Font
          .FontStyle = "Bold"
          .Color = -16776961
        End With
      End If
    End If
  End With
Next cll
End Sub
 
update:
The previous offering would also highlight numbers form 70 to 90 anywhere in the model number so here's a correction:
Code:
Sub blah()
For Each cll In Selection.Cells  'Range("C3:C43").Cells
  With cll
    x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
    If x > 0 Then
      y = CLng(Mid(cll.Value, x, 2))
      If y >= 70 And y <= 90 Then
        With .Characters(Start:=x, Length:=2).Font
          .FontStyle = "Bold"
          .Color = -16776961
        End With
      End If
    End If
  End With
Next cll
End Sub

At first I could not get the VBA to work, BUT I highlighted Column C and then it worked. Is there a way around having to highlight Column C before launching the VBA? Normally having to take the extra step to highlight would not be a big issue except in this case, I have more than 20,000 rows to deal with and multiple tabs in the Excel Workbook. Thanks for your help!
 
If always starting at row 3 and always column C then try replacing the For each cll… line with:
Code:
For Each cll In Range(Cells(3, "C"), Cells(Rows.Count, "C").End(xlUp)).Cells
(operates on the active sheet).
 
Outstanding! That worked!

One more question, please. How do I insert the final VBA code into this current VBA?

Code:
Sub ChangeCase()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Formula Info" Then
'      Change "Formula Info" sheet name or you can use sheet index# instead of name.
         
            If ws.Cells(Rows.Count, 5).End(xlUp).Row > 2 Then
'          This line was added to "fix" Error 400 which was caused by blank tab(s).
'    The "Next Tech" tab has no data, and its header is in row 2.
'    The part which returns the last row of data is:  ws.Cells(Rows.Count, 5).End(xlUp).Row
'    which will return 3 or more as long as the worksheet has data; thus subtracting 2 from this value returns any number from 1 upwards.
'    However, when the worksheet has no data, the above code will return 2, and subtracting 2 from this = 0, which is an invalid row number in Excel.
'    To check this, we test whether the value returned by the above code is greater than 2; if so, we proceed further, else we exit.
                     
                With ws.[E3:F3].Resize(ws.Cells(Rows.Count, 5).End(xlUp).Row - 2)
'              E3:F3 array tells where to apply change(s).  (Rows.Count, 5) tells in which column to start.
'              The following line changes all characters in array defined by Columns E and F to upper case.
                    .Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))
                End With
             
                With ws.[A3:D3].Resize(ws.Cells(Rows.Count, 5).End(xlUp).Row - 2)
'              A3:D3 array tells where to apply change(s).  (Rows.Count, 5) tells in which column to start.
'              The following line removes leading and trailing spaces in the array of Columns A through F.
'              .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) yields only removing leading and trailing spaces.
'              Added CLEAN to remove leading and trailing ASCII characters 0-32.
                    .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))
                End With
'------B  E  T  W  E  E  N -----H--E--R--E------------------------
'            This VBA segment changes the TV Model screen size between 70 and 90 to red and Bold and '            starts in Row 3, Column C, and for each tab.
'           

            
                    For Each cll In Range(Cells(3, "C"), Cells(Rows.Count, "C").End(xlUp)).Cells
                With cll
                    x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
                        If x > 0 Then
                            y = CLng(Mid(cll.Value, x, 2))
                            If y >= 70 And y <= 90 Then
                                With .Characters(Start:=x, Length:=2).Font
                                    .FontStyle = "Bold"
                                    .Color = -16776961
                                End With
                            End If
                        End If
                End With
                Next cll
'   
'-------A  N  D    H  E  R  E  ?---------------------------------
                             
            End If
        End If
    Next
End Sub
 
Last edited:
The placing should be fine, but alter:
Code:
      For Each cll In Range(Cells(3, "C"), Cells(Rows.Count, "C").End(xlUp)).Cells
to:
Code:
      For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells
 
Back
Top