Excel Forum

Code: Select all

Sub FillCellsVertically()
    Dim rng As Range
    Dim cell As Range
    Dim skipColors As Variant
    Dim counter As Integer
    ' Define the range to check
    Set rng = Range("A1:N20") ' Change this to your desired range
    ' Define the colors to skip (RGB color codes)
    skipColors = Array(RGB(255, 165, 0), RGB(255, 192, 0)) ' Add more colors to skip as needed
    ' Set the counter to zero
    counter = 0
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the cell has a fill color
        If cell.Interior.Pattern <> xlNone Then
            ' Check if the fill color is not in the skip colors array
            If Not IsInArray(cell.Interior.Color, skipColors) Then
                ' Increment the counter
                counter = counter + 1
                ' Fill the current cell and the cells below it with the same color
                cell.Resize(rng.Rows.count - cell.Row + 1).Interior.Color = cell.Interior.Color
            End If
        End If
    Next cell
End Sub
Function IsInArray(val As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If val = element Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

Code: Select all

Sub FillCellsVertically()
    Dim rng As Range
    Dim cell As Range
    
    ' Define the range to check
    Set rng = Range("A1:N20") ' Change this to your desired range
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the cell has a fill color
        If cell.Interior.Pattern <> xlNone Then
            ' Fill the current cell and the cells below it with the same color
            cell.Resize(rng.Rows.count - cell.Row + 1).Interior.Color = cell.Interior.Color
        End If
        ' Check if the current row is a multiple of 8
        If ((cell.Row + 1) - 1) Mod 8 = 0 Then
            ' Fill the current cell with orange color
            cell.Interior.Color = RGB(255, 165, 0)
        End If
    Next cell
End Sub