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

 

[sage_bob]

Hi,

The code below may get you started. It will loop through a list of cells, from cell 'A1' to the last row of the worksheet, and copy the cell's value if the cell's colour index matches. This was done in Excel 2007 so you'll probably need to change this to match your chosen colour. The easiest way is to record a macro while you colour a cell, then check the color index the macro recorded.

Sub CopyOnGreen()

    Dim l As Long
    Dim ws As Worksheet

    Set ws = ActiveSheet

    For l = 1 To ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        If ws.Cells(l, 1).Interior.ColorIndex = 5296274 Then
            ws.Cells(l, 2).Value = ws.Cells(l, 1).Value
        End If
    Next l

End Sub

You can amend the code to work down/across any list by amending the row/column reference within the brackets.

Hope that all makes sense and helps a little.

 

[stags81]

Thank you for the head start Bob,

Is there a way to do this as a VBA function so I wouldn't have to run a macro every time? I'm not very experienced in VBA, so if you/anyone can indicate how I might color and copy the cells from columns B through O and paste them one column to the right, that'd be great.

Thanks again!

 

[Peter_SSs]

There is still the issue of what Excel version you are using and therefore what 'green' you are referring to, but see if this helps. The code goes in a standard module and the function is used in the sheet as shown in D12 (copied down).

<font face=Courier New><br><SPAN style="color:#00007F">Function</SPAN> IsGreen(<SPAN style="color:#00007F">ByRef</SPAN> r <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">If</SPAN> r.Interior.ColorIndex = 4 <SPAN style="color:#00007F">Then</SPAN><br>        IsGreen = r.Value<br>    <SPAN style="color:#00007F">Else</SPAN><br>        IsGreen = vbNullString<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN><br></FONT>

Excel Workbook
	B	C	D
12	5	8	8
13		cat
14		dog	dog
Sheet1

 

[basile]

Hello,

I use Excel 2010 and I'm trying to do something very close to Mike, but not quite... you can maybe help me:

I have a list of people (1 person per row). From column AA to BZ (52 columns), I list all the actions I plan with them for each month of a period of time. All actions are written in black, but 1/pers is written in red, it's the key action for each person.

In another column, I would like to copy the key action for each person.

So I'm trying to come up with a function that would copy in column B all the actions written in red in columns AA to BZ.

Can you help me??
thank you!

There is still the issue of what Excel version you are using and therefore what 'green' you are referring to, but see if this helps. The code goes in a standard module and the function is used in the sheet as shown in D12 (copied down).


Function IsGreen(ByRef r As Range)
****If r.Interior.ColorIndex = 4 Then
********IsGreen = r.Value
****Else
********IsGreen = vbNullString
****End If
End Function


Sheet1

*	B	C	D
12	5	8	8
13	*	cat	*
14	*	dog	dog

<tbody>
</tbody>

Spreadsheet Formulas

Cell Formula C12 =B12+3 D12 =IsGreen(C12) <tbody> </tbody>

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

 

[Peter_SSs]

Hello,

I use Excel 2010 and I'm trying to do something very close to Mike, but not quite... you can maybe help me:

I have a list of people (1 person per row). From column AA to BZ (52 columns), I list all the actions I plan with them for each month of a period of time. All actions are written in black, but 1/pers is written in red, it's the key action for each person.

In another column, I would like to copy the key action for each person.

So I'm trying to come up with a function that would copy in column B all the actions written in red in columns AA to BZ.

Can you help me??
thank you!

Welcome to the MrExcel board!

I understand you to be saying that there would be at most one cell per row that is coloured. If there are more, this function will just return the first coloured value (searching by rows) in the target range.
The function requires a range and a ColorIndex input. ColorIndex for red is 3.

Function FindColr(r As Range, ColIdx As Long) As String
  Dim Found As Range
  
  Application.Volatile
  Application.FindFormat.Clear
  Application.FindFormat.Font.ColorIndex = ColIdx
  Set Found = r.Find(What:="*", SearchOrder:=xlByRows, SearchFormat:=True)
  If Not Found Is Nothing Then FindColr = Found.Value
  Application.FindFormat.Clear
End Function

Here's just part of my sheet, with function:

Excel Workbook
	B	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ
2	4	1	2	3	4	5	6	7	8	9	10
3	j	a	b	c	d	e	f	g	h	i	j
4	aa	aa	ab	ac	ad	ae	af	ag	ah	ai	aj
5		xx	xx	xx	xx	xx	xx	xx	xx	xx	xy
6	53	56	55	54	53	52	51	50	49	48	47
Sheet1

Note that changing the colour of a cell font does not trigger a recalculation so the function result would not automatically update if a font is changed in a row. If you want that to be a bit more responsive you could try putting this code in the Worksheet's Module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Columns("B").Calculate
End Sub

 

[basile]

Works great! thank you so much!

 

[Peter_SSs]

Works great! thank you so much!

Glad it helped.

If there are more, this function will just return the first coloured value (searching by rows) in the target range.

That statement isn't quite correct. If it is possible that you could have more than one colored cell in a row and you need the first one returned, rather than any one, post back and I'll modify.

 

[basile]

in most cases there will only be 1 red, but it could be that there are 2 or 3 in which case i'd like the first one to be copied, indeed.
so what should i modify?

thank you

 

[Peter_SSs]

in most cases there will only be 1 red, but it could be that there are 2 or 3 in which case i'd like the first one to be copied, indeed.
so what should i modify?

thank you

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