Home/ Questions/Q 6401
Next
In Process
Computing Staff
  • 6
Asked: 2021-11-19T05:39:55+00:00 In:

Macro To Remove Some Text With Condition And Add Color Shade

  • 6

<td>Hello,<p>So I made a macro to format a table. I will post the macro below and there are comments that explain things.</p><p>Here’s how my table looks like: <a href=”https://web.archive.org/web/20201204141704/http://i65.tinypic.com/1606l5f.jpg” target=”_blank” rel=”nofollow”>http://i65.tinypic.com/1606l5f.jpg</a><br>No, there is no shading on the cells, it’s the background I use (as a Windows OS setting).<br>I hope the picture can be displayed.</p><p><b>I would like to do 2 more things, and I don’t know how:</b><br><b>1.</b> Remove the white text – either remove it after the conditional formatting VBA, or replace the conditional formatting VBA with some code to remove all duplicates except first occurrence from columns A and B only.</p><p>I tried several codes found online and adapted, but none worked. I’m guessing because of the conditional formatting, but dunno really.</p><p><b>2.</b> Add cell color red or whatever to the entire rows that contain a client in column B, but only to those rows (they would be 2, 18 and 24 in the image). </p><p><b>Here is my macro without parts that I think are irrelevant to fonts and shading:</b></p><p></p><pre>’ Page setup: A4, Portrait, Center horizontally, Zoom 100%.
With ActiveSheet.PageSetup
.LeftMargin = Application.CentimetersToPoints(0.196850393700787)
.RightMargin = Application.CentimetersToPoints(0.196850393700787)
.TopMargin = Application.CentimetersToPoints(0.393700787401575)
.BottomMargin = Application.CentimetersToPoints(0.393700787401575)
.HeaderMargin = Application.CentimetersToPoints(0.393700787401575)
.FooterMargin = Application.CentimetersToPoints(0.393700787401575)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = True
.CenterVertically = False
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = False
.AlignMarginsHeaderFooter = False
End With

‘ Conditional formatting: color in white any duplicate values, except their first appearance.
Range(“A2:A279″).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:=”=A1=A2”
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ColorIndex = 2 ‘ white color
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

‘ Conditional formatting: color in white any duplicate values, except their first appearance.
Range(“B2:B279″).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:=”=B1=B2”
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ColorIndex = 2 ‘ white color
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

‘ Conditional formatting font face and font size for LANDSCAPE page
‘ arial font by default; if you want other, add line Cell.Font.Name = “Font Name”
For Each Cell In ActiveSheet.UsedRange
If ActiveSheet.PageSetup.Orientation = xlPortrait Then
Cell.Font.Size = 12 ‘ font size for PORTRAIT
Cell.Font.Name = “Tahoma”
Else
Cell.Font.Size = 16 ‘ font size for LANDSCAPE
Cell.Font.Name = “Tahoma”
End If
Next Cell

‘ Delete text of white color in columns A and B —————————– NOT WORKING
Dim rng As Range
Set rng = [B2:B279]
For Each Cell In rng
If Cell.Font.ColorIndex = 2 Then
Cell.ClearContents
End If
Next Cell

‘ Add shading to row if cell with black text is in column B —————————– TBA
‘ TO BE ADDED</pre><br><p align=”right”><font size=”1″><i>message edited by Mrrrr</i></font></p></td>

Share

    1 Answer

    1. You are correct in your assumption that the CF font color is not the same as the Font.ColorIndex. A CF Fill color is not the same as the Interior.ColorIndex either. Therefore, you cannot “test” a cell via VBA for those colors.

      If you want to find cells that have been Conditionally Formatted, you basically have to search for cells that meet the criteria that set the CF. VBA can set CF and clear CF, but it can’t find CF’d cells by searching for CF’d formats.

      Now, in your case, you appear to have an option. Replace this…

      ' Delete text of white color in columns A and B     ----------------------------- NOT WORKING
    Dim rng As Range
    Set rng = [B2:B279]
    For Each Cell In rng
        If Cell.Font.ColorIndex = 2 Then
        Cell.ClearContents
        End If
    Next Cell

      …with this, and both of your requirements will be met (for Column B, at least)

      'Delete duplicate entries, Apply Red fill to Row of remaining entry
For rw = 279 To 2 Step -1
 If Cells(rw, 2) = Cells(rw - 1, 2) Then
  Cells(rw, 2).ClearContents
 Else: Cells(rw, 2).EntireRow.Interior.ColorIndex = 3
 End If
Next

      How To Post Data or Code —> Click Here Before Posting Data or VBA Code

      message edited by DerbyDad03

      • 0