copy/paste cell if color

[stags81]

Hello,

I'm trying to write a macro which would copy and paste (without formats) the cell contents one cell to the right if it's a cetain color (say, green). I believe it would be a function, not a macro, correct? Can someone assist?

Thanks!

Mike

 

[basile]

did a test, seems to work.
thanks heaps!

 

[Peter_SSs]

did a test, seems to work.
thanks heaps!

Good news!

 

[Major_Sarcasm]

My previous function failed to correctly identify the first coloured value if it was the first cell in the range and there was another colored cell also in the range. For example, in my previous sample data, if cell AA6 was also red then the function would still have returned "53" rather than "56".

This version hopefully overcomes that problem.

Function FindColr(r As Range, ColIdx As Long) As String
  Dim Found As Range
  
  Application.Volatile
  Application.FindFormat.Clear
  With r
    If .Areas.Count = 1 Then
      Application.FindFormat.Font.ColorIndex = ColIdx
      Set Found = .Find(What:="*", After:=.Cells(.Rows.Count, .Columns.Count), _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)
      If Not Found Is Nothing Then FindColr = Found.Value
      Application.FindFormat.Clear
    End If
  End With
End Function

Sorry to resurrect an old thread, but it directly relates to the code above.

Using Excel 2010, I'm trying to make a small change to the function so that it searches for cell colour rather than font colour. All I have done is changed "Application.FindFormat.Font.ColorIndex" to "Application.FindFormat.Interior.ColorIndex" but for some reason I get a "#VALUE!" error when the original code works perfectly well on a small range of cells.

So the code is:

Function FindColrCell(r As Range, ColIdx As Long) As String
  Dim Found As Range
  
  Application.Volatile
  Application.FindFormat.Clear
  With r
    If .Areas.Count = 1 Then
      Application.FindFormat.Interior.ColorIndex = ColIdx
      Set Found = .Find(What:="*", After:=.Cells(.Rows.Count, .Columns.Count), _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)
      If Not Found Is Nothing Then FindColrCell = Found.Value
      Application.FindFormat.Clear
    End If
  End With
End Function

 

[Peter_SSs]

.. I get a "#VALUE!" error when the original code works perfectly well on a small range of cells.

So the code is:

Function FindColrCell(r As Range, ColIdx As Long) As String
  Dim Found As Range
  
  Application.Volatile
  Application.FindFormat.Clear
  With r
    If .Areas.Count = 1 Then
      Application.FindFormat.Interior.ColorIndex = ColIdx
      Set Found = .Find(What:="*", After:=.Cells(.Rows.Count, .Columns.Count), _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)
      If Not Found Is Nothing Then FindColrCell = Found.Value
      Application.FindFormat.Clear
    End If
  End With
End Function

I get the same result. Try this version instead. It should concatenate & report all the values in the range where the cells have the particular interior ColorIndex.

Function FindColrCell(r As Range, ColIdx As Long) As String
  Dim rCell As Range
  Dim sVals As String

  Application.Volatile
  With r
    For Each rCell In r
      If rCell.Interior.ColorIndex = ColIdx Then
        sVals = sVals & ", " & rCell.Text
      End If
    Next rCell
    FindColrCell = Mid(sVals, 3)
  End With
End Function

 

[Michael M]

Ben tornato Peter !!
Hope you had a great break !!!

BTW....that's all of my italian...

 

[Peter_SSs]

Ben tornato Peter !!
Hope you had a great break !!!

Thanks.
Yes.

 

[Major_Sarcasm]

Worked perfectly, thanks Peter.

 

[Peter_SSs]

Worked perfectly, thanks Peter.

Good news. Thanks for letting us know.