Script to find all colored cells in a range

user_19056600 0
Viewed 36

I need to create a script that will type a value into every colored cell in a given range I am very new to all of this so forgive my ignorance. From the reading I've done I've come up with this

Sub Macro1()
    Dim colors As Range, found As Boolean

    Set colors = ActiveSheet.Range("D19:CV68")

            found = VBA.IsNull(colors.DisplayFormat.Interior.ColorIndex)
            
            colors = IIf(found, "1", " ")
End Sub

This gets me very close to what I need but instead of placing the 1 in just the colored cells it places the one in every cell in the range. I'm sure there is a very basic way to do this that I am just not aware of. I appreciate any help that I can get. Thanks!

vba excel
2 Answers

You need to iterate through each cell in the range testing for no color.

    Dim colors As Range
    Dim cell As Range

    Set colors = Range("D19:CV68")
    
    For Each cell In colors
        If cell.Interior.ColorIndex = xlColorIndexNone Then
            cell.Value = ""
        Else
            cell.Value = 1
        End If
    Next cell
user_116435280

Fill Colored Cells of a Range

  • Adjust the values in the constants section.
Sub FillColored()
    
    Const rgAddress As String = "D19:CV68"
    Const nStr As String = ""
    Const yStr As String = "1"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range: Set rg = ws.Range(rgAddress)
    
    Dim yrg As Range
    Dim nrg As Range
    Dim cel As Range
    
    For Each cel In rg.Cells
        If cel.DisplayFormat.Interior.ColorIndex = xlNone Then
            If nrg Is Nothing Then Set nrg = cel Else Set nrg = Union(nrg, cel)
        Else
            If yrg Is Nothing Then Set yrg = cel Else Set yrg = Union(yrg, cel)
        End If
    Next cel
    
    If Not nrg Is Nothing Then nrg.Value = nStr
    If Not yrg Is Nothing Then yrg.Value = yStr

End Sub
user_98140690
Related