Finding all cells that have been filled with any color and highlighting corresponding column headers in excel vba
Solution 1
The most performant solution would be to search using recursion by half-interval. It takes less than 5 seconds to tag the columns from a worksheet with 150 columns and 30000 rows.
The code to search for a specific color:
Sub TagColumns()
Dim headers As Range, body As Range, col As Long, found As Boolean
' define the columns for the headers and body
Set headers = ActiveSheet.UsedRange.Rows(1).Columns
Set body = ActiveSheet.UsedRange.Offset(1).Columns
' iterate each column
For col = 1 To headers.Count
' search for the yellow color in the column of the body
found = HasColor(body(col), vbYellow)
' set the header to red if found, green otherwise
headers(col).Interior.color = IIf(found, vbRed, vbGreen)
Next
End Sub
Public Function HasColor(rg As Range, color As Long) As Boolean
If rg.DisplayFormat.Interior.color = color Then
HasColor = True
ElseIf VBA.IsNull(rg.DisplayFormat.Interior.colorIndex) Then
' The color index is null so there is more than one color in the range
Dim midrow&
midrow = rg.Rows.Count \ 2
If HasColor(rg.Resize(midrow), color) Then
HasColor = True
ElseIf HasColor(rg.Resize(rg.Rows.Count - midrow).Offset(midrow), color) Then
HasColor = True
End If
End If
End Function
And to search for any color:
Sub TagColumns()
Dim headers As Range, body As Range, col As Long, found As Boolean
' define the columns for the headers and body
Set headers = ActiveSheet.UsedRange.Rows(1).Columns
Set body = ActiveSheet.UsedRange.Offset(1).Columns
' iterate each column
For col = 1 To headers.Count
' search for any color in the column of the body
found = VBA.IsNull(body(col).DisplayFormat.Interior.ColorIndex)
' set the header to red if found, green otherwise
headers(col).Interior.color = IIf(found, vbRed, vbGreen)
Next
End Sub
Solution 2
Before:
Running this short macro:
Sub FindingColor()
Dim r1 As Range, r2 As Range, r As Range
Dim nFirstColumn As Long, nLastColumn As Long, ic As Long
Set r1 = ActiveSheet.UsedRange
nLastColumn = r1.Columns.Count + r1.Column - 1
nFirstColumn = r1.Column
For ic = nFirstColumn To nLastColumn
Set r2 = Intersect(r1, Columns(ic))
For Each r In r2
If r.Interior.ColorIndex <> xlNone Then
r2(1).Interior.ColorIndex = 27
Exit For
End If
Next r
Next ic
End Sub
produces:
I just don't know about the speed issue. If the colored cells are near the top of the column, the code will run super fast; if the colored cells are missing or near the bottom of the column, not so much.
EDIT#1:
Please note that my code will not find cells colored conditionally.
Solution 3
My proposal using AutoFilter
method of Range
object
it runs quite fast
Option Explicit
Sub FilterByFillColor()
Dim ws As Worksheet
Dim headerRng As Range
Dim iCol As Long, RGBColor As Long
Set ws = ThisWorkbook.Worksheets("HeadersToColor") '<== set it to your actual name of the data worksheet
Set headerRng = ws.Range("headers") '<== I set a named range "headers" in my test sheet addressing the cells that cointains all headers. but you may use explicit address ie: 'ws.Range("B2:EU150")' for a 150 columns header range
RGBColor = RGB(255, 0, 0)
Application.ScreenUpdating = False
headerRng.Interior.Color = vbGreen
With headerRng.CurrentRegion
For iCol = 1 To .Columns.Count
.AutoFilter Field:=iCol, Criteria1:=RGBColor, Operator:=xlFilterNoFill
If .Columns(iCol).SpecialCells(xlCellTypeVisible).Count < .Rows.Count Then headerRng(iCol).Interior.Color = vbRed
.AutoFilter
Next iCol
End With
Application.ScreenUpdating = True
End Sub
CaffeinatedMike
Python-enthusiast Flask, Microservices, APIs, Webscraping, requests, and BeautifulSoup are just a few of my favorite tools and libraries in works I've worked with extensively over the last 6-7 years. Self-taught, maybe 3 formal college classes pertaining to CS before realizing how much I hated conventional learning. I tend to learn on-the-fly, as-needed, because I find I'm better able to adapt that way instead of trying to remember every last shred of documentation or syntax in a language or library. My Google-fu is pretty well-mastered. I focus on whichever language is needed at the time, having dabbled in Kodi Media Center Add-On development, Home Assistant & Automation Apps like Tasker to name a few of the side project areas of interest. I also love consuming REST APIs, but have also created one full-fledged one myself and plenty of microservice ones along the way. I mostly love working with Python & jQuery and never had the chance to fully-learn newer front-end JS libraries such as Vue.js (but would love to focus on this one) and the same goes for infrastructures such as AWS. Thus far in my professional career I've worked for relatively small companies that don't have full-fledge development teams, so the on-the-job learning opportunities are few-and-far between. Especially when it comes to be taught new infrastructures, languages, or frameworks.
Updated on June 29, 2022Comments
-
CaffeinatedMike almost 2 years
My problem:
I've made a large (2,000 line) macro that runs on our company's template and fixes some common issues and highlights other issues we have prior to importing. The template file always has 150 columns and is in most instances 15,000+ rows (sometimes even over 30,000). The macro works well, highlighting all the cells that contain errors according to our data rules, but with a file with so many columns and rows I thought it'd be convenient to add a snippet to my macro that would have it find all of the cells that have been highlighted and then highlight the column headers of the columns that contain those highlighted cells.
Methods I've found while searching for a solution:
SpecialCells
xlCellTypeAllFormatConditions
only works for conditional formatting, so that isn't a plausible method for my situation-
Rick Rothstein's UDF from here
Sub FindYellowCells() Dim YellowCell As Range, FirstAddress As String Const IndicatorColumn As String = "AK" Columns(IndicatorColumn).ClearContents ' The next code line sets the search for Yellow color... the next line after it (commented out) searches ' for the ColorIndex 6 (which is usually yellow), so use whichever code line is applicable to your situation Application.FindFormat.Interior.Color = vbYellow 'Application.FindFormat.Interior.ColorIndex = 6 Set YellowCell = Cells.Find("*", After:=Cells(Rows.Count, Columns.Count), SearchFormat:=True) If Not YellowCell Is Nothing Then FirstAddress = YellowCell.Address Do Cells(YellowCell.Row, IndicatorColumn).Value = "X" Set YellowCell = Cells.Find("*", After:=YellowCell, SearchFormat:=True) If YellowCell Is Nothing Then Exit Do Loop While FirstAddress <> YellowCell.Address End If End Sub
This would be perfect with a few tweaks, except our files can have multiple colorfills. Since our template is so large I've learned that it takes quite some time to run one instance of
Find
to find just one colorfill in theUsedRange
. Using filtering, maybe cycling through all the columns and checking each if they contain any cell that has any colorfill. Would that be any faster though?
So, my question:
- How could I accomplish finding all columns that contain any colorfilled cells? More specifically, what would be the most efficient (fastest) way to achieve this?
-
Admin about 8 yearsIf you examined the Range.DisplayFormat property, you should be able to pick up manually colored and CF colored cells in one pass. e.g.
If r.DisplayFormat.Interior.ColorIndex <> xlNone Then
-
Gary's Student about 8 years@Jeeped Sadly I am still using Excel 2007/Windows7
-
Gary's Student about 8 years@Jeeped I put the restriction in EDIT#1
-
CaffeinatedMike about 8 yearsThis is a solution, but I believe it would be quite slow for my situation as the highlights can be scattered about at the top, middle, and/or bottom. Also, @Jeeped I'm only looking to find colors that are not filled from conditional formatting.
-
Gary's Student about 8 years@CaffeinatedCoder As soon as my code finds the first colored cell in a column, it immediately colors the header and skips to the next column.
-
Gary's Student about 8 years@CaffeinatedCoder Only an experiment can determine if the code is "fast enough."
-
CaffeinatedMike about 8 yearsYou're right, I might just be thinking about how in the past iterating through that many rows 150 times took awhile. But, then again I guess it depends on what's done in the loop. You do have a point that this might be quicker since as soon as it/if finds a highlighted cell it will move on to the next row. I'll test it out and see how it fairs. Thanks!
-
CaffeinatedMike about 8 yearsThis is a brilliant solution. I just have two questions though. How could this be modified so it would search for any color or any cell that isn't
vbNull
? Second, is your last comment accurate? I would think if it werevbNull
that it would mean there weren't any colors in that range. Maybe you could help try to clear that up (explain that) for me? -
CaffeinatedMike about 8 yearsJust another comment to make sure you saw my first one since I know you were editing while I posted
-
Florent B. about 8 yearsI've updated the response to search for any color. And yes it's accurate, the colorIndex is Null when there is more than 1 color and -4142 for the default color.
-
CaffeinatedMike about 8 yearsThanks for the updated solution and explanation! I'll test this code tomorrow morning and mark this as the answer once I see it working.
-
CaffeinatedMike about 8 yearsIt works perfectly! And it's so efficient/fast. Thanks so much for sharing this method with me!
-
user3598756 about 8 yearsfine and fast solution. just two warnings. The first being you have to adjust either
rowCount =...
or.Resize(rowCount)
since as they are now set they also consider the first row just below theUsedRange
last one. Most probably it'll not be colorfilled but should it (accidentally) be it'd result in wrong header coloring. The second being that it's assumed data cells begin at column 1 and header row index is 1. Should your header not begin at cell A1 then it'd miss some cell and or column checking. Finally it can be made quite faster (if needed!: I try and edit the post with improvement) -
CaffeinatedMike about 8 yearsSince our company adheres to strict data rules those two issues/limitations won't be of concern in my situation. Also, @florentbr I have a simple and (probably) silly follow-up question. If I've filled cells by using
.Interior.Color
throughout my code will this still pick those cell colors up? The reason I ask is because I notice it's looking for.DisplayFormat.Interior.ColorIndex
, not.Color
. I'm just niave in knowing whether or not.Color
properties will yield a.ColorIndex
. Sorry blush -
Florent B. about 8 years@CaffeinatedCoder, yes the .Interior.ColorIndex is updated when the .Interior.Color is assigned either manually, by a format condition or by code.
-
CaffeinatedMike about 8 yearsGreat, then this is the perfect solution for me. Thanks for helping clear that up for me