Expert: Tom Ogilvy - 11/4/2009

Question
QUESTION: Hi Tom,

I have a workbook for which I have used macro to find the difference between 2 cells (let's assume C & D) and conditional format on cell D when the value is not equal to cell C (I have used Yellow Color). What I want is to copy the whole row where the Conditional fomat has been applied and paste it to the next sheet. Since there will be more than one cell that will be conditionally formatted, It should copy the row and paste below one another in the next sheet. I'm sorry if i'm not clear about this. Please let me know so that I can explain it again

Thanks
Vicky

ANSWER: Vicky,

If you have used a macro to mark column D yellow, then I assume you changed the interior color of the cell and didn't actually apply a conditional format setting to the cell.  

If so


Sub copyData()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, cell As Range
Dim r As Range

Set sh1 = Worksheets("Sheet1")  ' sheet with data
Set sh2 = Worksheets("Sheet2")  ' sheet to copy to

Set r1 = sh1.Range(sh1.Cells(2, "D"), sh1.Cells(Rows.Count, "D").End(xlUp))
For Each cell In r1
 If cell.Interior.ColorIndex = 6 Then
    If r Is Nothing Then
      Set r = cell
    Else
      Set r = Union(r, cell)
    End If
 End If
Next
If Not r Is Nothing Then
 r.EntireRow.Copy sh2.Cells(2, "A")
Else
 MsgBox "Nothing to copy"
End If
End Sub

Worked for me. It assumes the interior of the cells in column D for the rows to be copies are colored with a yellow color that carries a colorindex value of 6.

--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

QUESTION: Hi Tom,

Thanks for the swift reply. I tried the code and it says "Nothing to copy" as you have mentioned in the code. I have pasted below, code that I used to conditional format the range. Hope this will help you with my query. All I need is when the code finds any cell in column D where conditional format is applied based on the criteria, it should copy the whole row and paste it in the next sheet (There are around 800 rows which might increase or decrease in the worksheet so if the data increases then the code should be able to identify the new rows and copy paste all the rows which have a conditionally formatted cell in column D to the next sheet)

Sheets("Change in steps").Select
   lastrow = Worksheets("Change in steps").Range("A65536").End(xlUp).Row
   With Worksheets("Change in steps").Range("D2")
   Range("D2").Select
   Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
       Formula1:="=C2"
   With Selection.FormatConditions(1).Interior
        .Color = 65535
   End With
   Selection.FormatConditions(1).StopIfTrue = True
   Selection.Copy
   Range("D3").Select
   Range(Selection, "D3:D" & lastrow&).Select
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
       SkipBlanks:=False, Transpose:=False
   Range("D2").Select
   Application.CutCopyMode = False
   End With
   Range("A2").Select

The code might look atrocious :-) as I'm very new to Macros, this is what I could come up with . Please advice

Cheers,
Vicky

ANSWER: Vicky,

Unfortunately, you can't test if conditional formatting is applied to the cell by querying any property or attribute of the cell.  So the next best approach is to just test the same condition since it is known.  

Sub copyData()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, cell As Range
Dim r As Range

Set sh1 = Worksheets("Change in Steps")  ' sheet with data
Set sh2 = Worksheets("Sheet2")  ' sheet to copy to

Set r1 = sh1.Range(sh1.Cells(2, "D"), sh1.Cells(Rows.Count, "D").End(xlUp))
For Each cell In r1
' test for not being equal with the corresponding cell in column C
If cell.value <> cell.offset(0,-1).value then
   If r Is Nothing Then
     Set r = cell
   Else
     Set r = Union(r, cell)
   End If
End If
Next
If Not r Is Nothing Then
r.EntireRow.Copy sh2.Cells(2, "A")
Else
MsgBox "Nothing to copy"
End If
End Sub

--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

QUESTION: Hi Tom,

This serves the purpose. What do I do if there were two columns which had the conditional format criteria?? For eg. in the above code cell D checks if value is not equal to cell C and copy paste the data but if i have the same condition in cell F what code should I be looking at??. So basically all the rows should get copied to sheet2 where cell D is not equal to cell C (like given above) and cell F is not equal to cell E

Thanks for the help in advance

Vicky

Answer
vicky

so I understand the condition to be both  c <> d and e <> f then

Sub copyData()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, cellC As Range, cellD as Range
Dim cellE as Range, cellF as Range
Dim r As Range

Set sh1 = Worksheets("Change in Steps")  ' sheet with data
Set sh2 = Worksheets("Sheet2")  ' sheet to copy to

Set r1 = sh1.Range(sh1.Cells(2, "D"), sh1.Cells(Rows.Count, "D").End(xlUp))
For Each cell In r1
' test for not being equal with the corresponding cell in column C
 set cellC = cell.offset(0,-1)
 set cellD = cell
 set cellE = cell.offset(0,1)
 set cellF = cell.offset(0,2)
If cellC.value <> cellD.value AND _
  cellE.value <> cellF.vaue  then
  If r Is Nothing Then
    Set r = cell
  Else
    Set r = Union(r, cell)
  End If
End If
Next
If Not r Is Nothing Then
r.EntireRow.Copy sh2.Cells(2, "A")
Else
MsgBox "Nothing to copy"
End If
End Sub

Just in case, if you want to copy the row if either of c <> d or e <> f or both are not equal then change
If cellC.value <> cellD.value AND _
  cellE.value <> cellF.vaue  then

to

If cellC.value <> cellD.value OR _
  cellE.value <> cellF.value  then

--
Regards,
Tom Ogilvy