VBA update and clear the value without delay

[elsuji]

Hi,

I am having the following code for update and clear the value

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim a As Range, rng As Range
    Dim counter As Long
    Set rng = Sheets("Data").Range("C30:C187")
    For Each a In rng
        If (Sheets("Data").Range("C6") = "CP18" Or Sheets("Data").Range("C6") = "CP18 TM" Or Sheets("Data").Range("C6") = "M21Z" Or Sheets("Data").Range("C6") = "M25Z") _
        And (a > 2.25 Or a < -2.25) Then
            counter = counter + 1
            a.Offset(0, 0).Interior.ColorIndex = 44
            Sheets("Data").Range("H" & a.Row) = "Error " '& counter            
       Else
            a.Offset(0, 0).Interior.ColorIndex = 0
            Sheets("Data").Range("H" & a.Row) = ""            
        End If        
    Next a
End Sub

In this the cell C value >2.25 & <-2.25, then the cell C color will change and in H the "Error" will update. And if the condition is not meet then the color should remove from C and Error should remove from H.

For example C16 value is >2.25 & <-2.25 then the C16 color will change and in H16 it will update "Error". If C16 value not in >2.25 & <-2.25 then the color will remove and "Error" also to be remove from H16.

At present the above code when the (Sheets("Data").Range("H" & a.Row) = "" )code is enabled then it is check all the row from 30 to 187 and it very delay to update.

Can any one please help me where the mistake is the code and how to rectify it.

For your reference the file is attached with this.

[Paul_Hossler]

I don't see why you're doing a lot of that, but

1. I think you want Worksheet_Change and NOT Worksheet_SelectionChange

2. I think you need to disable events while you're updating the sheet

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
 
Application.EnableEvents = False        '   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

and turn them on when you leave

    Dim a As Range, rng As Range
    Dim counter As Long
    Set rng = Sheets("Data").Range("C30:C187")
    For Each a In rng
        If (Sheets("Data").Range("C6") = "CP18" Or Sheets("Data").Range("C6") = "CP18 TM" Or Sheets("Data").Range("C6") = "M21Z" Or Sheets("Data").Range("C6") = "M25Z") _
        And (a > 2.25 Or a < -2.25) Then
            counter = counter + 1
            a.Offset(0, 0).Interior.ColorIndex = 44
            Sheets("Data").Range("H" & a.Row) = "Error " '& counter
       Else
            a.Offset(0, 0).Interior.ColorIndex = 0
            Sheets("Data").Range("H" & a.Row) = ""
        End If
    Next a
    Application.EnableEvents = True         '   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

[elsuji]

Dear Paul,

There is no changes with this code. Its look like same as previous one

[Paul_Hossler]

Look closer

Worksheet_Change instead of Worksheet_SelectionChange

Added
Application.EnableEvents = False and Application.EnableEvents = True

[elsuji]

I changed the code as per your instruction. May be I had done some mistakes.

Please do me a favour. Can you update new code on sample file and send me please

[Paul_Hossler]

Sure

I changed 1 line and added 2 in the data sheet event handler. They're marked with ----------------------------------------------------

It does not lock up the computer when data is changed, but as I said I don't understand the overall macro

[SamT]

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cel As Range
Dim rngC30C187 As Range
Dim counter As Long
Dim C6Check As Boolean 'Default is FALSE at declaration

Application.EnableEvents = False 'in order that no one can change selection while code is running

Set rngC30C187 = Sheets("Data").Range("C30:C187")

Select Case Sheets("Data").Range("C6").Value
    Case "CP18", "CP18 TM", "M21Z", "M25Z"
        C6Check = True
End Select

If C6Check Then
    rngC30C187.Interior.ColorIndex = xlColorIndexNone
    Range("H30:H187").Value = ""
    
    For Each Cel In rngC30C187
        If (Cel > 2.25 Or Cel < -2.25) Then
            Cel.Interior.ColorIndex = 44
            Cel.Offset(0, 5) = "Error " '& counter 'Offsets to column H
        End If
    Next Cel
End If

Application.EnableEvents = True
End Sub

Personally, I prefer to use an Excel Control Toolbox button to run subs like yours. Or sometimes I format a cell to look like a button then use

Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel  As Boolean)
If Target address Not "A2" Then 'use your cell address here
   Cancel = True
   Exit Sub
End If
 'regular code goes here

[elsuji]

Dear Sam,

Thanks for your reply. Your code is working great.

With this same code it is possible to check the range F30:F187 and update "Error" on H

[SamT]

With this same code it is possible to check the range F30:F187 and updae "Error" on H

Yes.

Add and Set rngF30F187 then analyze my code and replicate the For Each Cel loop inside the If C6Check... End If

[elsuji]

Hi Sam,

Thanks for your help. Now the code is working as per my requirement.