Format cells with "sum" in using vba macro

[Cammandk]

I want to format specific cells in a worksheet that have the "sum" equation in.
I could propable do this using conditional formatting but don't want to have CF on a large no of cells so I think running a macro would be a better use of resources.

Conditions:

Specific Sheet - Sheet1
Column C
Unprotected cell
cell has "sum" equation in
draw box around cell
fill cell with yellow

I thought that this macro could be run when the worksheet is activate/deactivated?

Thanks
David

 

[NARAYANK991]

Hi David ,

Can you give an example of what you mean by SUM equation ?

Basically , a cell / range has a .HasFormula property , as well as a .Formula property , so these can be used , but things will be clearer if you can give an example of the SUM equation.

Narayan

 

[Cammandk]

Hi Narayan

Thanks for reply. I mean =5000-sum(c5:c10)

I only want to flag/format "sum" cells so not a cell with =200*4

David

 

[Sam Mathai Chacko]

Just writing this on the run here. This is just one way of doing it.

Sub SMC()

    Dim rng As Range

    For Each rng In ActiveSheet.UsedRange.Cells
        If rng.Locked = False And InStr(1, UCase(rng.Formula), "SUM(") > 0 Then
            rng.Interior.Color = vbRed
        End If
    Next rng

End Sub

 

[Marc L]

Hi,

in case of thousands cells to check, faster Find method is my way :

Sub YellowBoxSumCells()
    Dim Cel As Range
 
    With Sheet1.UsedRange
        If .Column > 3 Then Exit Sub

        With .Columns(4 - .Column)
            Set Cel = .Find("SUM(", , xlFormulas, xlPart, , , True)
 
            If Not Cel Is Nothing Then
                Application.ScreenUpdating = False
                                       AD$ = Cel.Address
                Do
                    If Not Cel.Locked Then
                          Cel.Borders.LineStyle = xlContinuous
                        Cel.Interior.ColorIndex = 36
                    End If
 
                    Set Cel = .FindNext(Cel)
                Loop Until Cel.Address = AD
 
                                   Set Cel = Nothing
                Application.ScreenUpdating = True
            End If
        End With
    End With
End Sub