VBA macro find blank RGB(0, 255, 0) colored cells in range and put in 1 value

May be as start point

Sub Test()
    'Range("A1").Interior.Color = RGB(0, 255, 0)
    Dim cel As Range
    
    Application.ScreenUpdating = 0
        For Each cel In Range("A1:D20") 'Change To Suit
            If cel.Interior.Color = RGB(0, 255, 0) Then cel.Value = 1
        Next cel
    Application.ScreenUpdating = 1
End Sub

Try this version

Sub Green_is_1()
    Dim cel As Range
    Dim rng As Range
    Dim mrng As Range
    
    Set rng = Range("N17:NN300")

    Application.ScreenUpdating = False
        For Each cel In rng
            If cel.Interior.Color = RGB(0, 255, 0) Then
                 If mrng Is Nothing Then
                    Set mrng = cel
                Else
                    Set mrng = Union(cel, mrng)
                End If
           End If
        Next cel
        
        If Not mrng Is Nothing Then
            mrng.Value = 1
        End If
    Application.ScreenUpdating = True
End Sub

Hello KG869,

You will notice that my code uses no loops and is fast.

You may want to include ScreenUpdating=False and then True at the end, before End Sub.

Option Explicit
Sub Winon()
    
    Application.ScreenUpdating = False
    
    Range("N17").Select
    Application.FindFormat.Locked = True
    Application.FindFormat.FormulaHidden = False
    With Application.ReplaceFormat.Interior
        .Color = 65280
    End With
    Range("N17:NN300").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate
    Range("N17:NN300").Replace What:="", Replacement:="1", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    Range("N17").Select
    
    Application.ScreenUpdating = True

End Sub

Sub Reset()

Range("N17:NN300").ClearContents
Range("N17").Select

End Sub

Regards.

Hello KG869,

Please try the Code below;

Sub Winon()
    Range("N17").Select
    Application.FindFormat.Locked = True
    Application.FindFormat.FormulaHidden = False
    With Application.ReplaceFormat.Interior
        .Color = 65280
    End With
    Range("N17:NN300").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate
    Range("N17:NN300").Replace What:="", Replacement:="1", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    Range("N17").Select

End Sub


Sub Reset()

Range("N17:NN300").ClearContents
Range("N17").Select

End Sub

Regards.

Hi KG869,

Maybe yo have a lot of other things happening behind the scenes at the same time?

So can anyone tell me from all of the responders is the reason excel hangs really because there are so many cells to check a put a value in. Is there more efficiency some other way.

If that includes my Proposed solution, then please try the Code below;

Option Explicit
Sub Winon()
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("N17").Select
    Application.FindFormat.Locked = True
    Application.FindFormat.FormulaHidden = False
    With Application.ReplaceFormat.Interior
        .Color = 65280
    End With
    Range("N17:NN300").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate
    Range("N17:NN300").Replace What:="", Replacement:="1", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    Range("N17").Select
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Regards.

Thank you for the feedback KG869,

Glad I could contribute, and thank you also for adding to my Reputation. I really appreciate it!

Regards.

@ JOHN H. DAVIS,

Did you perhaps experienced the same issue?

Thank you.

Hi KG869,

I cannot replicate your problem.

Do you perhaps have other macros with the same name in your Module? Have you tried resetting the VBE and save the Workbook before trying it again? Please try that quickly, while I hang around.

Thank you.

Thank you KG869,

In the meantime please see the problem free attachment.

'Till later then.

That problem in Winon's code would happen if there are no blank cells found, then it tries to activate nothing.

Hello KG869,

Yes, I found the same hilarious issue. Fast but maybe too fast!LOL

My initial code became unstable and unreliable cause I tried to keep it short, and in the process, came short myself. OUCH!!!

Stop laughing please, it hurts man!

Please try the revised attachment now, which sports the Code below;

Option Explicit
Sub Winon()
    
      Range("N17").Select
    With Application.FindFormat.Interior
        .Color = 65280
    End With
    
    Range("N17:NN300").Replace What:="", Replacement:="1", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True

End Sub

Sub Reset()

Range("N17:NN300").ClearContents
Range("N17").Select
End Sub

The real culprit was this line below:

    Range("N17:NN300").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate

Kind regards.

@Arkadi,

That problem in Winon's code would happen if there are no blank cells found, then it tries to activate nothing.

Be careful. Very careful with your wild accusations.

Have you tried my new revised attachment?

Thank you for your input here my friend, I appreciate it!

See my reply in the Post above, which could hold true to your observation with my previous attempts.

Kind Regards.

@Winon
Nice solution my friend! It simply ocurred to me that it is hard to activate nothing, as you yourself pointed out... my only "accusation" is that you are brilliant (usually)

KG869, thanks for acknowledging all the posters, very considerate

Hi KG869,

Thank you for the positive feedback, and kind words, glad I could be of some help!

@Arkadi,

Please get lost! You have hurt my feelings beyond repair.

Thank you for the kind acknowledgement of my contribution my friend, and the "Rep". It is much appreciated!

Best Regards to all of the participants in this Thread.