Copying highlighted cells to another cell

[MasterN]

Hello All,

first off I really am imprssed by the great effort in the forum ...


I made a macro that uses conditional formatting to highlight duplicates,triplicates, etc .
now I want the macro to look for the now-highlighted (red) -duplicate- cells and put them in AA column and remove the duplicates from the AA column ...and look for triplicate (Yellow) cells and put them in AC...the thing is I can`t get it to copy the highlighted values to the specified columns....here is the code I have so far

Sub ConditionalFormatting()
'
' ConditionalFormatting Macro
'

   Dim g As Integer
   Dim h As Integer
   Dim u As Integer
   Dim s As String
   
   
   g = 6
   h = 6
   u = 6
    
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTIF($C$6:$Y$611,C6)=4"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColor = 255
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTIF($C$6:$Y$611,C6)=3"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTIF($C$6:$Y$611,C6)=2"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
' ----------------------------------------------------

    
     For Each Cell In Selection
    
' this if condition doesn`t work 

        If Cell.Interior.Color = 255 Then
             g = g + 1
           
             Cell(g, 29).Value = Cell.Value
        
           
           
         
        End If
       
      Next

End Sub

Thanks in advance

[pike]

Hi MasterN,
Welcome to the forum.
You cant select condital format cells by colour.
You will have to select the cells with the condition formula and the cells value

[MasterN]

Hi MasterN,
Welcome to the forum.
You cant select condital format cells by colour.
You will have to select the cells with the condition formula and the cells value

Thank you Pike for the quick reply .

well .. the cell values are variable .. the data are fed to excel through another program .. so everytime Excel is opened the data is changed .. so I can`t select the cells with their values .. how can I select the cells with the condition formula ?!

EDIT: something came to my mind ... is the problem with color ?! .. should I get the condition formula to change something else in the cell in the first place ?! if so , what should be changed !!

[pike]

No, the conditional format cell colour is different to the cell.interior.color, which you can select cells by

[MasterN]

No, the conditional format cell colour is different to the cell.interior.color, which you can select cells by

I got what you mean .. is there a way to get Conditional Format through VBA to change the Cell.Interior.Color ?! ..

I tried experimenting with

If Cell.FormatConditions(1).Interior.Color = 255 Then

             Cell(g, 29).Value = Cell.Value
             g = g + 1

        End If

in the If statement .. but still I can`t get it to work

[pike]

you could use a find synatx
the first find to AA
run the find again these go to AC

[MasterN]

you could use a find synatx
the first find to AA
run the find again these go to AC

What should the find syntax look for ? .. and then what would the implementation of the loop be like ?

[MasterN]

Ok ... I almost solved it ...here is what I came up with so far ...as my code highly depend on conditional formatting ...I thought then I should change the conditional format highlight into the cell.interior color ...this function change the FormatConditions.Interior.Color into Cell.Interior.Color

Function ConditionalColor(rg As Range, FormatType As String) As Long 
     'Returns the color index (either font or interior) of the first cell in range rg. If no _
    conditional format conditions apply, Then returns the regular color of the cell. _ 
    FormatType Is either "Font" Or "Interior" 
    Dim cel As Range 
    Dim tmp As Variant 
    Dim boo As Boolean 
    Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String 
    Dim i As Long 
     
     'Application.Volatile    'This statement required if Conditional Formatting for rg is determined by the _
    value of other cells 
     
    Set cel = rg.Cells(1, 1) 
    Select Case Left(LCase(FormatType), 1) 
    Case "f" 'Font color
        ConditionalColor = cel.Font.ColorIndex 
    Case Else 'Interior or highlight color
        ConditionalColor = cel.Interior.ColorIndex 
    End Select 
     
    If cel.FormatConditions.Count > 0 Then 
         'On Error Resume Next
        With cel.FormatConditions 
            For i = 1 To .Count 'Loop through the three possible format conditions for each cell
                frmla = .Item(i).Formula1 
                If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
                     'Conditional Formatting is interpreted relative to the active cell. _
                    This cause the wrong results If the formula isn 't restated relative to the cell containing the _
                    Conditional Formatting--hence the workaround using ConvertFormula twice In a row. _ 
                    If the Function were Not called using a worksheet formula, you could just activate the cell instead. 
                    frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell) 
                    frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel) 
                    boo = Application.Evaluate(frmlaA1) 
                Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
                    Select Case .Item(i).Operator 
                    Case xlEqual ' = x
                        frmla = cel & "=" & .Item(i).Formula1 
                    Case xlNotEqual ' <> x
                        frmla = cel & "<>" & .Item(i).Formula1 
                    Case xlBetween 'x <= cel <= y
                        frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")" 
                    Case xlNotBetween 'x > cel or cel > y
                        frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")" 
                    Case xlLess ' < x
                        frmla = cel & "<" & .Item(i).Formula1 
                    Case xlLessEqual ' <= x
                        frmla = cel & "<=" & .Item(i).Formula1 
                    Case xlGreater ' > x
                        frmla = cel & ">" & .Item(i).Formula1 
                    Case xlGreaterEqual ' >= x
                        frmla = cel & ">=" & .Item(i).Formula1 
                    End Select 
                    boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
                End If 
                 
                If boo Then 'If this Format Condition is satisfied
                    On Error Resume Next 
                    Select Case Left(LCase(FormatType), 1) 
                    Case "f" 'Font color
                        tmp = .Item(i).Font.ColorIndex 
                    Case Else 'Interior or highlight color
                        tmp = .Item(i).Interior.ColorIndex 
                    End Select 
                    If Err = 0 Then ConditionalColor = tmp 
                    Err.Clear 
                    On Error Goto 0 
                    Exit For 'Since Format Condition is satisfied, exit the inner loop
                End If 
            Next i 
        End With 
    End If 
     
End Function 
 
 
Sub NonConditionalFormatting() 
    Dim cel As Range 
    Application.ScreenUpdating = False 
     
     'Remove conditional formatting from entire worksheet
     'For Each cel In ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
    For Each cel In Selection 'Remove conditional formatting from selected cells
        If cel.FormatConditions.Count > 0 Then 
            cel.Interior.ColorIndex = ConditionalColor(cel, "Interior") 'Replace the interior (highlight) color
            cel.Font.ColorIndex = ConditionalColor(cel, "Font") 'Replace the font color
            cel.FormatConditions.Delete 'Delete all the Format Conditions for this cell
        End If 
    Next cel 
     
    Application.ScreenUpdating = True 
End Sub

I then applied a for loop .. to get the resulting cells into a column

For Each Cell In Selection
    
        If Cell.Interior.Color = 255 Then
            Cell(g, 29).Value = Cell.Value
            g = g + 1
        End If
       
      Next

The bad thing is ..well actually two bad things .. ... first off .. it takes almost 4 minutes to finish and it freezes Excel during calculating the Macro ... the second thins is that I got the results scattered around in almost 12 columns .. every other column .. instead of ONE column as I intended for it to do . I can`t tell what is wrong with the for loop ..

[pike]

MasterN
try this code it may be faster

Sub tester()
    Dim OneCollection As New Collection, TwoCollection As New Collection, ThreeCollection As New Collection
    Dim x, y, DeleteCollection As New Collection
    For Each ritem In Range("C6:Y611")
        On Error Resume Next
        OneCollection.Add ritem.Value, CStr(ritem.Value)
        If Err.Number = 457 Then
            On Error Resume Next
            TwoCollection.Add ritem.Value, CStr(ritem.Value)
            If Err.Number = 457 Then
                ThreeCollection.Add ritem.Value, CStr(ritem.Value)
            End If
        End If
    Next
    For x = 1 To TwoCollection.Count
        Cells(x, 27) = TwoCollection(x)
    Next
    Debug.Print "  "
    For y = 1 To ThreeCollection.Count
        Cells(y, 29) = ThreeCollection(y)
    Next
    For Each ritem In Range("C6:Y611")
        On Error Resume Next
        DeleteCollection.Add ritem.Value, CStr(ritem.Value)
        If Err.Number = 457 Then
            ritem.ClearContents
        End If
    Next
End Sub

[MasterN]

I think I reached a point that I need a fresh eyes to look at the code as I can`t figure out why the code does what it does ... here is what I`ve done so far ..

1- the code applies three formulas of Conditional Formatting . ( check)
2- then look for cells with that conditional Format applied to .. and convert the FormatConditions.Interior.Color into cell.Interior.Color . (check)
3- Delete the Conitional Formatting from the cells (check)
4- look for cells with "red" color and put them in the column AA ( start of the problem here I guess )
5- look for cells with "Yellow" color and put them in AC .( the code doesn`t do this step at all)
6- look for cells with "green" color and put them in AE
7- delete duplicates from column AA .
8- delete Duplicates from Column AC
9- delete Duplicated from column AE


I attached the sheet with the macro in it .. hopefully someone will be able to spot what is wrong with the code .. thank you in advance

here is the code as well

 

Function ConditionalColor(rg As Range, FormatType As String) As Long
     'Returns the color index (either font or interior) of the first cell in range rg. If no _
    conditional format conditions apply, Then returns the regular color of the cell. _
    FormatType Is either "Font" Or "Interior"
    Dim cel As Range
    Dim tmp As Variant
    Dim boo As Boolean
    Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
    Dim i As Long
     
     'Application.Volatile    'This statement required if Conditional Formatting for rg is determined by the _
    value of other cells
     
    Set cel = rg.Cells(1, 1)
    Select Case Left(LCase(FormatType), 1)
    Case "f" 'Font color
        ConditionalColor = cel.Font.ColorIndex
    Case Else 'Interior or highlight color
        ConditionalColor = cel.Interior.ColorIndex
    End Select
     
    If cel.FormatConditions.Count > 0 Then
         'On Error Resume Next
        With cel.FormatConditions
            For i = 1 To .Count 'Loop through the three possible format conditions for each cell
                frmla = .Item(i).Formula1
                If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
                     'Conditional Formatting is interpreted relative to the active cell. _
                    This cause the wrong results If the formula isn 't restated relative to the cell containing the _
                    Conditional Formatting--hence the workaround using ConvertFormula twice In a row. _
                    If the Function were Not called using a worksheet formula, you could just activate the cell instead.
                    frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
                    frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
                    boo = Application.Evaluate(frmlaA1)
                Else 'If "Value Is", then identify the type of comparison operator and build comparison formula
                    Select Case .Item(i).Operator
                    Case xlEqual ' = x
                        frmla = cel & "=" & .Item(i).Formula1
                    Case xlNotEqual ' <> x
                        frmla = cel & "<>" & .Item(i).Formula1
                    Case xlBetween 'x <= cel <= y
                        frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
                    Case xlNotBetween 'x > cel or cel > y
                        frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
                    Case xlLess ' < x
                        frmla = cel & "<" & .Item(i).Formula1
                    Case xlLessEqual ' <= x
                        frmla = cel & "<=" & .Item(i).Formula1
                    Case xlGreater ' > x
                        frmla = cel & ">" & .Item(i).Formula1
                    Case xlGreaterEqual ' >= x
                        frmla = cel & ">=" & .Item(i).Formula1
                    End Select
                    boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
                End If
                 
                If boo Then 'If this Format Condition is satisfied
                    On Error Resume Next
                    Select Case Left(LCase(FormatType), 1)
                    Case "f" 'Font color
                        tmp = .Item(i).Font.ColorIndex
                    Case Else 'Interior or highlight color
                        tmp = .Item(i).Interior.ColorIndex
                    End Select
                    If Err = 0 Then ConditionalColor = tmp
                    Err.Clear
                    On Error GoTo 0
                    Exit For 'Since Format Condition is satisfied, exit the inner loop
                End If
            Next i
        End With
    End If
     
End Function


Sub ConditionalFormatting()
'
' ConditionalFormatting Macro
'



   Dim g As Integer
   Dim h As Integer
   Dim u As Integer
   Dim s As String
   
   
   g = 5
   h = 5
   u = 5
     
    Range("C6:Y611").Select
     
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTIF($C$6:$Y$611,C6)=4"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColor = 255
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTIF($C$6:$Y$611,C6)=3"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=COUNTIF($C$6:$Y$611,C6)=2"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
' ----------------------------------------------------



 
 

    Dim cel As Range
    Application.ScreenUpdating = False
     
     'Remove conditional formatting from entire worksheet
     'For Each cel In ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
    For Each cel In Selection 'Remove conditional formatting from selected cells
        If cel.FormatConditions.Count > 0 Then
            cel.Interior.ColorIndex = ConditionalColor(cel, "Interior") 'Replace the interior (highlight) color
            cel.Font.ColorIndex = ConditionalColor(cel, "Font") 'Replace the font color
            
        End If
    Next cel
     
    
Selection.FormatConditions.Delete 'Delete all the Format Conditions for this cell

For Each Cell In Selection
    
        If Cell.Interior.Color = 255 Then
              Range("AA1").Offset(g, 0).Value = Cell.Value
            g = g + 1
        End If
       
     

    

    If Cell.Interior.Color = 65535 Then
              Range("AC1").Offset(h, 0).Value = Cell.Value
            h = h + 1
        End If


    If Cell.Interior.Color = 5287936 Then
              Range("AE1").Offset(u, 0).Value = Cell.Value
            u = u + 1
        End If
       
    
    Next
    
    Dim x               As Long
    Dim LastRow         As Long
     
    LastRow = Range("AA65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("AA1:AA" & x), Range("AA" & x).Text) > 1 Then
            Range("AA" & x).Delete
        End If
    Next x
    
    
    LastRow = Range("AC65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("AC1:AC" & x), Range("AC" & x).Text) > 1 Then
            Range("AC" & x).Delete
        End If
    Next x
    
     LastRow = Range("AE65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("AE1:AE" & x), Range("AE" & x).Text) > 1 Then
            Range("AE" & x).Delete
        End If
    Next x
    
    
    Application.ScreenUpdating = True
End Sub

[pike]

did you try the code?

[MasterN]

did you try the code?

I was waiting to solve the issue first as I didn`t want to add another problem while trying to figure out why it isn`t working the way it is supposed to .I was thinking get it to work right then worry about efficiency .. this thread was about the highlighting issue and I believe it is solved ( I just wrote another thread to keep it in particular and mark this thread solved ..I was wondering how to do so though )

[pike]

Hi MasterN,
You can't copy conditionally formated coloured cells.

[MasterN]

Hi MasterN,
You can't copy conditionally formated coloured cells.

Hello Pike,

the cells are no longer conditionally fomated .. the custom function ConditionalColor .. changes the Conditional Format coloured cells into a normally colored cell .. as I already mentioned in my previous post ... now the Cell.Interior.Color = FormatConditions.Interior.Color ... I tested it and it works ( please check the function in the previous post )... the problem isn`t in the conditional format anymore .. this is why I mentioned that I want to mark this thread as solved ...

[pike]

Hi MasterN,
Appoligises,I didnt read that ,very very good idea. I have to subscribe to the other thread .

[MasterN]

Thank you, Pike ..

here is the link to the other thread hopefully you can help with it .. I tried to explain the code the best I can .. so someone would be able to go through it and help get it over with

http://www.excelforum.com/excel-prog...al-format.html