martinez_pedro
New Member
- Joined
- Aug 19, 2009
- Messages
- 28
does anyone has a macro that can remove all conditional formating but keeping the curren format
i have a spreadsheet that contains about 60000 rows and i will like to be able to remove condition so i can sort by cell color
any ideas suggestions i will apreciate
i have this macro that some times works but most of the time doesnt work
i found this macro on the internet so i dont know who wrote it
i have a spreadsheet that contains about 60000 rows and i will like to be able to remove condition so i can sort by cell color
any ideas suggestions i will apreciate
i have this macro that some times works but most of the time doesnt work
i found this macro on the internet so i dont know who wrote it
Code:
Sub NonConditionalFormatting(control As IRibbonControl)
Dim cel As Range
Dim boo As Boolean
Dim frmla As String
Dim i As Long
Application.ScreenUpdating = False
'For Each cel In ActiveSheet.UsedRange 'Remove conditional formatting from entire worksheet
For Each cel In Selection 'Remove conditional formatting from selected cells
If cel.FormatConditions.Count > 0 Then
cel.Activate
With cel.FormatConditions
For i = 1 To .Count
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then
boo = Application.Evaluate(frmla)
Else
Select Case .Item(i).Operator
Case xlEqual ' =
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla)
End If
If boo Then
cel.Font.ColorIndex = .Item(i).Font.ColorIndex
cel.Interior.ColorIndex = .Item(i).Interior.ColorIndex
Exit For
End If
Next i
.Delete
End With
End If
Next cel
Application.ScreenUpdating = True
End Sub