Need Macro to Format Cells based on corresponding cell values

Hi,

I have a pretty large sheet (3000+ rows), whereby if the cell in column A of a row contains a number of between 1 and 150, then I would like the corresponding cell in Column E to be grey with a border around it. Obviously an arduous task if done using Copy & Paste and unfortunately I need this to happen in a number of sheets and don't fancy RSI at the end of the exercise.

As part of a second part of the project, I need to be able to 'Unlock' the cells that end up as grey w/border so that I can protect the sheet and only leave the grey cells as editable.

Hope someone can help!

TJ

For the first part maybe:

Sub feckoffcup()
Dim lr As Long
Dim rcell As Range

lr = Cells(Rows.Count, 1).End(xlUp).Row

For Each rcell In Range("A2:A" & lr)

    If rcell.Value > 1 Then
    
        If rcell.Value < 150 Then
        
            rcell.Offset(, 4).Select
            
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .Weight = xlMedium
                        .ColorIndex = xlAutomatic
                    End With
                
            rcell.Offset(, 4).Interior.ColorIndex = 15
            
        End If
        
    End If
    
Next rcell
            
End Sub

Thanks amillion guys for looking at this, I am getting a syntax error on the following line:

    Set ws = Sheets("Sheet4")

I have changed "Sheet4" (which it just happened to be coincidentally!) to the name of my sheet "Business" but I am getting the same error.

Sorry - just realised that the color kicked in within the CODE, the line did include the COLOR as you had included!

I changed the name of the Worksheet to Sheet4 just in case, however I am still getting the same message - screenshot attached:

Attachment 193732

As you can see I attempted to change Sheets to Worksheets also to no avail - the error message is identical when Sheets is in place

I changed the name of the Worksheet to Sheet4 just in case, however I am still getting the same message - screenshot attached:

Capture.JPG

Thats at Jeff - worked a treat - thank you very much!