HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

VBA Excel - Conditional Formatting Colour Grab

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
formattinggrabexcelconditionalcolourvba

Problem

This code gets the cell's colour regardless of whether it's set from conditional formatting or not. It currently works on 2010 and unsure about older versions of excel.

My question is is there a way to make this code more efficient?

-
Such as being able to highlight an area for the code to search rather than setting For stantments

-
Getting it to search for a specific colour you set rather than red or whatever has been set

-
Anything else anyone can think of

Sub myCFtest()

For q = 1 To 26

sCol = Split(ActiveCell.Address, "$")(1)
sColNum = sCol & 1
Range(sColNum).Select

For i = 1 To 100

sColNum = ActiveCell.Address

    If Range(sColNum).DisplayFormat.Interior.Color = 255 Then
        Y = ActiveCell.Address
        MsgBox ("Red Cell Found At " & Y)
    End If

ActiveCell.Offset(1, 0).Select

Next i

ActiveCell.Offset(0, 1).Select

Next q

MsgBox ("No Red Cell Found")

End Sub

Solution

I can't test this code to see if it works because I have 2007 on this computer. But, I do have some things to add.

First things first, I have no idea what the variables are for - there is no description. You also don't have Option Explicit on and none of the variables are dimed. That's the first thing to address.

What is q? It iterates 1 to 26, but I don't see it being used anywhere. You're just doing the entire thing 26 times? Why? Oh, because you're using .Select - I'll get to that.

The same thing goes to i.

You use sCol = Split(ActiveCell.address,"$")(1) to get the column letter? Why not just get the column with ActivecCell.Columns?

Speaking of ActiveCell - why are you using it? Why not get a variable like Dim RangeToTest and set it to Sheets(1).Range("A1:A26") or whatever? At least Set RangeToTest = Selection - but using selection and activecell is generally bad form.

Instead this entire thing could be (using whatever numbers you need to use)-

Dim RowNumber As Long
  Dim ColumnNumber As Long

  For RowNumber = 1 To 100
    For ColumnNumber = 1 To 26
        'do stuff to Cells(RowNumber, ColumnNumber)
    Next ColumnNumber
  Next RowNumber


If you're not sure you can do something like this to get what you need -

Dim RowNumber As Long
  Dim ColumnNumber As Long
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Dim LastColumn As Long
  LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

  For RowNumber = 1 To LastRow
    For ColumnNumber = 1 To LastColumn
        'do stuff to Cells(RowNumber, ColumnNumber)
    Next ColumnNumber
  Next RowNumber


I can't tell what you're doing here -

sCol = Split(ActiveCell.Address, "$")(1)
sColNum = sCol & 1
Range(sColNum).Select

For i = 1 To 100

sColNum = ActiveCell.Address


From what I can tell you get the column, set sColNum (is that a string? A range?) to the first cell in the column, then you select the Range of the SColNum (string?). And then you set the sColNum that was selected to its own .address? What are you accomplishing here? Seems like it has something to do with your i loop - which can be eliminated and you can just use the example I gave, or something similar.

Now you check for .Interior.Color = 255 and if it's found, you msgbox where it was found with Y as activecell.address when sColNum is already the activecell.address. You don't need Y to say the least.

Instead you could do something like this -

Dim FindInteriorColor As Long

  FindInteriorColor = 255

  If Cells(RowNumber, ColumnNumber).DisplayFormat.Interior.Color = FindInteriorColor Then
    MsgBox ("Red Cell Found at " & Cells(RowNumber, ColumnNumber))
  End If


Now all you need to do is change the variable FindInteriorColor to whatever the value is of the color you want to find. You'd still need to change your msgbox to say the color, but that could be avoided with an input box or variable or something.

Again, I can't test the actual function of the code, but these are improvements you could make at least, if you want to run through cell by cell looking for something and saying each time it's found. If you want to only find the first one, just put an Exit Sub in the if loop.

In response to your comment - a simple way to get the letter of a column number (in case you need it in the future) is something like -

Sub test()
Dim RowBegin As Long
RowBegin = InStr(2, Cells(1, 200).Address, "$")
Dim ColumnLetter As String
ColumnLetter = Mid(Cells(1, 200).Address, 2, RowBegin - 2)
MsgBox ColumnLetter
End Sub

Code Snippets

Dim RowNumber As Long
  Dim ColumnNumber As Long

  For RowNumber = 1 To 100
    For ColumnNumber = 1 To 26
        'do stuff to Cells(RowNumber, ColumnNumber)
    Next ColumnNumber
  Next RowNumber
Dim RowNumber As Long
  Dim ColumnNumber As Long
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Dim LastColumn As Long
  LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

  For RowNumber = 1 To LastRow
    For ColumnNumber = 1 To LastColumn
        'do stuff to Cells(RowNumber, ColumnNumber)
    Next ColumnNumber
  Next RowNumber
sCol = Split(ActiveCell.Address, "$")(1)
sColNum = sCol & 1
Range(sColNum).Select

For i = 1 To 100

sColNum = ActiveCell.Address
Dim FindInteriorColor As Long

  FindInteriorColor = 255

  If Cells(RowNumber, ColumnNumber).DisplayFormat.Interior.Color = FindInteriorColor Then
    MsgBox ("Red Cell Found at " & Cells(RowNumber, ColumnNumber))
  End If
Sub test()
Dim RowBegin As Long
RowBegin = InStr(2, Cells(1, 200).Address, "$")
Dim ColumnLetter As String
ColumnLetter = Mid(Cells(1, 200).Address, 2, RowBegin - 2)
MsgBox ColumnLetter
End Sub

Context

StackExchange Code Review Q#117934, answer score: 6

Revisions (0)

No revisions yet.