Select first colored cell in column A then copy it to E1

[Peter90]

Please help me to find a solution in excel VBA to find the first colored cell in the column "A" and copy it to the Range (E1)
Thank you in advance!

This is my first post!

 

[NeonRedSharpie]

Welcome!

Sub findFirstColoredCellAndExileIt()

    Dim rowStart As Integer
    Dim rowEnd As Long
    
    rowStart = 1
    rowEnd = ActiveSheet.Cells(Rows.count, "A").End(xlUp).Row
    
    For x = rowStart To rowEnd Step 1
    
        If Cells(x, 1).Interior.ColorIndex <> xlColorIndexNone Then
            Cells(1, 5).Value = Cells(x, 1)
            Exit For
        End If
        
    Next x


End Sub

 

[Peter90]

Thank you for your fast reply, it's really cool but I should copy only the cell's color. Could you help me in it,please?

 

[NeonRedSharpie]

Oh, so the format?

Sub findFirstColoredCellAndExileIt()

    Dim rowStart As Integer
    Dim rowEnd As Long
    
    rowStart = 1
    rowEnd = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    For x = rowStart To rowEnd Step 1
    
        If Cells(x, 1).Interior.ColorIndex <> xlColorIndexNone Then
            Cells(x, 1).Copy
            Cells(1, 5).PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            
            Exit For
        End If
        
    Next x


End Sub

 

[Peter90]

Wow. Something like this, but I forgot to say that the first cell has no data only the color. (For example saturday or any feast day in a shedule so I need the color only, because I would like to get a sample cell of the actual mounth's colored cells, and The colored cells are always elsewhere.)

 

[Peter90]

Something like this but I would like to solve it by a more elegant method if it is possible, so for example I don't want to put "x" in the cells because I need only the color copy to the target cell, and if the first colored cell accidentally contain data it will be overwriten immediately.

Sub findFirstColoredCellAndExileIt()

Range("N4").Select
ActiveCell.FormulaR1C1 = "x"
Range("N5").Select
ActiveCell.FormulaR1C1 = "x"
Range("N6").Select
ActiveCell.FormulaR1C1 = "x"
Range("N7").Select
ActiveCell.FormulaR1C1 = "x"
Range("N8").Select
ActiveCell.FormulaR1C1 = "x"
Range("N9").Select
ActiveCell.FormulaR1C1 = "x"
Range("N10").Select
ActiveCell.FormulaR1C1 = "x"
Range("N11").Select
ActiveCell.FormulaR1C1 = "x"
Range("N12").Select
ActiveCell.FormulaR1C1 = "x"
Range("N13").Select
ActiveCell.FormulaR1C1 = "x"
Range("N14").Select
ActiveCell.FormulaR1C1 = "x"
Range("N15").Select
ActiveCell.FormulaR1C1 = "x"
Range("N16").Select
ActiveCell.FormulaR1C1 = "x"
Range("N17").Select
ActiveCell.FormulaR1C1 = "x"


Dim rowStart As Integer
Dim rowEnd As Long

rowStart = 1
rowEnd = ActiveSheet.Cells(Rows.Count, "N").End(xlUp).Row

For X = rowStart To rowEnd Step 1

If Cells(X, 14).Interior.ColorIndex <> xlColorIndexNone Then
Cells(X, 14).Copy
Cells(3, 18).PasteSpecial xlPasteFormats
With Selection
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.CutCopyMode = False

Exit For
End If

Next X

Range("N4:N17").Select
Selection.ClearContents
Range("N4").Select

End Sub