script to write 1's and zero's for cell color

**NPeters** · 05-07-2010, 11:41 AM

I have a very large excel workbook that has a sheet off almost 600,000 lines, column B has duplicates. i have done a conditional format to highlight all unique and first occurrences.
i am trying to write a VB script that will go down every row and if the cell is colored that write a 1 in cell z for that row if it is not colored then write a 0 in cell z for the row.

or a program that will in one sweep find the unique & first occurrences and mark the cell with 1 or 0

ANY help is appreciated.

**jeffreybrown** · 05-07-2010, 12:23 PM

Hello & Welcome to the forum,

I would suggest just using the formula =COUNTIF($B$2:B2,B2) and copy down.

If the value in B is unique you will get a 1 or if a duplicate you will get a 2, if a 3rd duplicate then a 3 and so on.

You can now build conditional formatting off of the results in Z.

If you want to return a zero, then incorporate an If statement =IF(COUNTIF($B$2:B2,B2)=1,0,1)

You could even do away with column Z and put this formula directly into conditional formatting.

**Palmetto** · 05-07-2010, 12:57 PM

Seeing as you are using Excel 2007 and it allows filtering by color, you can script this.
Here is an example you can build on:

Note: you will need to determine the RGB value of the cell color, which can be done by simply activating the cell and calling up the color pallet via Format Cells. If you have multiple cell colors then you will need multiple passes to accomplish.

Using the specialcells method will be much faster than looping through 600K cells.

Option Explicit

Sub Check_Cell_Color()

    Application.ScreenUpdating = False
    
    With Sheet1
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Range("B1:B600000").AutoFilter Field:=1, Criteria1:=RGB(242, 242, 242), Operator:=xlFilterCellColor
        .Range("Z1:Z600000").SpecialCells(xlCellTypeVisible).Value = 1
        .AutoFilterMode = False
        .Range("B1:A600000").AutoFilter Field:=1, Operator:=xlFilterNoFill
        .Range("Z1:Z600000").SpecialCells(xlCellTypeVisible).Value = 0
        .AutoFilterMode = False
    End With
    
    Application.ScreenUpdating = False

End Sub

**NPeters** · 05-07-2010, 01:52 PM

Thank you, you guys are great.
I have to know is there any way to do this with one pass?

Find the unique and first instance and then place the ones for those and 0’s for the duplicates?