Binary Macro

Hi Salmana, thanks for your query. The following subroutine should do the trick:

-----------------------

sub converttobinary

Dim myrows As Integer
Dim mycolumns As Integer

Application.ScreenUpdating = False

myrows = ActiveSheet.Range("c2").CurrentRegion.Rows.Count
mycolumns = ActiveSheet.Range("c2").CurrentRegion.Columns.Count

For rowloop = 1 To myrows


For columnloop = 1 To mycolumns

If ActiveSheet.Range("c2").Cells(rowloop, columnloop).Font.Color = 255 Then

ActiveSheet.Range("c2").Cells(rowloop, columnloop).Value = 1

Else

ActiveSheet.Range("c2").Cells(rowloop, columnloop).Value = 0

End If

Next columnloop


Next rowloop

Application.ScreenUpdating = True

end sub

-----------------------

Hope this helps,

Anthony