VBA optimization of finding colors in a selected range

[kwright88]

I am looking to improve the speed of this macro that finds the different colors in a selected range and lists them in Sheet2 with a white cell to the right of each found color. The program has several nested loops because I couldn't figure out how to compare one color to several colors. If anyone knows of a better way to approach finding colors in a selected range or how to optimize my code I would greatly appreciate it.


Sub ColorFinder()
Dim cll As Range
Dim n As Double
Dim clr As Long
Dim x As Double
Dim x_1 As Double
Dim fccheck As Double
Dim blackchk As Integer
Dim myRange As Range
Set myRange = Selection
'----------------------------------------------------------------------------------set counters
blckchk = 0
x = 1
x_1 = 1
n = 1
'----------------------------------------------------------------------------------color sheet2 black
Worksheets("Sheet2").Cells.Interior.ColorIndex = 1
'----------------------------------------------------------------------------------loop through selected range
For Each cll In myRange
clr = cll.Interior.ColorIndex
'----------------------------------------------------------------------------------check if color is black
If clr = 1 Then blckchk = 1
'----------------------------------------------------------------------------------loop through found colors
For i = 1 To x_1
If clr <> Worksheets("Sheet2").Cells(x, 1).Interior.ColorIndex Then
'----------------------------------------------------------------------------------count if colors don't match
fccheck = fccheck + 1
End If
x = x + 1
Next i
'----------------------------------------------------------------------------------check if color wasn't found
If fccheck = x_1 Then
Worksheets("Sheet2").Cells(n, 1).Interior.ColorIndex = clr
n = n + 1
End If
'----------------------------------------------------------------------------------reset counters
x_1 = x
x = 1
fccheck = 0
Next cll
'----------------------------------------------------------------------------------color column next to colors
If blckchk = 0 Then
n = n - 1
End If
Worksheets("Sheet2").Range("B1:B" & n).Interior.ColorIndex = 0
End Sub

 

[TonyJollans]

I haven't studied your code but this should do as you ask:

[blue]Dim Colors(1 To 56) As Boolean

Worksheets("Sheet2").Cells.Interior.ColorIndex = 1

For Each cll In myRange
    Select Case cll.Interior.ColorIndex
        Case xlColorIndexNone, xlColorIndexAutomatic
        Case Else: Colors(cll.Interior.ColorIndex) = True
    End Select
Next cll

r = 1
For n = 1 To 56
    If Colors(n) Then
        Worksheets("Sheet2").Cells(r, 1).Interior.ColorIndex = n
        Worksheets("Sheet2").Cells(r, 2).Interior.ColorIndex = xlColorIndexNone
        r = r + 1
    End If
Next n[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[kwright88]

Thank you for the help, the speed of this program is better than I could have hoped. I am new to VB so I am still running through the program to try to interpret how it works.

Thanks again