PDA

View Full Version : [SOLVED] VBA update and clear the value without delay



elsuji
09-23-2019, 11:18 AM
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
09-23-2019, 03:39 PM
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
09-24-2019, 05:31 AM
Dear Paul,

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

Paul_Hossler
09-24-2019, 06:14 AM
Look closer

Worksheet_Change instead of Worksheet_SelectionChange

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

elsuji
09-24-2019, 06:54 AM
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
09-24-2019, 07:02 AM
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
09-25-2019, 02:52 PM
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
09-25-2019, 08:42 PM
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
09-26-2019, 07:00 AM
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
09-28-2019, 10:06 AM
Hi Sam,

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