Is there a change event type that works on specific rows or ranges instead of on an entire worksheet?

[JLoewen]

I have a worksheet change event in development that is already large enough it visibly slows my system down. The change event iterates through about 500 rows of data based on the user entries. I am using the change event to guide the user in what entries are valid vs. invalid with colorcoding. There are several dozen comparisons and evaluations being done on each row. The total effect is that it takes about 4 seconds for the VBA to complete processing each time new data is entered.

Each row is evaluated independent of every other row so every time this process runs only 1 row is actually being changed. The other 499 are being processed unnecessarily.

Is there a way to setup a change event so that it targets only a particular row or range of cells instead of the entire worksheet?

Regards,

 

[Norie]

The first thing to do with Target is to check if it's in the range you want the code in the change event to be run for, otherwise the code will run on any change in any range on the worksheet.

For example, to check that a something has changed in, say, the range O15:AG515 you can use something like this,

If Intersect(Target, Range("O15:AG15")) Is Nothing Then
    ' change not in range O15:AG15, so don't execute code
    Exit Sub
End If

which would go right at the top of the code.

 

[Marcelo Branco]

Maybe something like

Dim rCell As Range
 
If Not Intersect(Target, Range("O15:AG515")) Is Nothing Then
    For Each rCell In Range("O" & Target.Row & ":AG" & Target.Row)
        'your code here to compare each cell in the correspondent row with some value
    Next rCell
End If

M.

 

[JLoewen]

Marcelo,

I think that is what I need to do.

 

[JLoewen]

I just finished updating my code per the Target,Range method and it looks like it worked.

Thank you.

Is it possible to have a code call this subroutine and iterate through all 500 rows? I am considering having a function do that as sort of a last step error check in case any of the inputs driving this particular sheet get changed.

 

[Marcelo Branco]

You are welcome. Glad to help.

About your question: iterate through all rows in O15:G515
Maybe

Dim rCell As Range, rRow As Range
 
If Not Intersect(Target, Range("O15:AG515")) Is Nothing Then
    For Each rRow In Range("O15:AG515").Rows
        For Each rCell In rRow.Cells
            'you code here.
            'Example - compares rCell with the value in column A in this row
            If rCell > Cells(rCell.Row, "A") Then rCell.Interior.Color = blue
        Next rCell
    Next rRow
End If

M.

 

[JLoewen]

Possibly...

Is there a way to possibly have another function (a button click type) that feeds it a list of target rows and call the work change event function?

I may need to restructure this by having the work change event call the function that does the work and then create a user activated function that iteratively calls the work function.

 

[Marcelo Branco]

Possibly...

Is there a way to possibly have another function (a button click type) that feeds it a list of target rows and call the work change event function?

I may need to restructure this by having the work change event call the function that does the work and then create a user activated function that iteratively calls the work function.

Not sure what you are looking for. Try some code and post here if you face some problem.

M.

 

[JLoewen]

I figured it out.

I've moved the bulk of my code into a module. The worksheet change event now calls the module.

Private Sub Worksheet_Change(ByVal Target As Range)
  
If Not Intersect(Target, Range("A15:AG515")) Is Nothing Then
    Call Module2.AHUerrorcheck(Target)
    End If
End Sub

I can also activate the module with a button activated sub routine:

Sub AHUErrorcheckMAN()
    Dim Target As Range
For i = 0 To 500
    Set Target = Range("A15").Offset(i)
    Call Module2.AHUerrorcheck(Target)
Next i
End Sub

Thank you for the help.

Regards,

 

[Marcelo Branco]

Good job, well done!

You are welcome.

M.

 

[offthelip]

The way you have programmed your loop can speeded up a huge amount. One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing a loop which loops down a range testing one row at a time which will take along time if you have got 500 rows it is much quicker to load the 500 lines into a variant array ( one worksheet access), ,you have got about 15 worksheet access in every loop
Unfortunately you can't get rid of all the access to the worksheet in yoiur loop because you are trying to format the cells , but you can get rid of the acces to the worksheet for the "if" tests. I have rewritten a bit your code to show you how to do this.
( You may not need this for this particular problem but is it worth learning how to write fast code rather than code that takes 4 seconds to run.

inarr=range("G15:S515")

' col G is Inarr,i,1) counting columns G,h I J you column M = 7, R= 12 and S=13
For i = 0 To 500
    
    
    
    'This set controls the color status of the Min Required Exhaust cells, Plan return and Plan Exhaust cells, HEPA cells (M, N, R & S)
    If inarr(i,7) = "" Then                                         'A quick check to see if the Min Req'd Exhaust column is empty
        m = 0                                                                   'Provides a value for the comparison in later statements
        Else: m = inarr(i,7)
        End If
        
    If inarr(i,1) = "No" Then
        If inarr(i,8) = "YES" Then                                          'If HEPA filtration is allowed
            Range("N15").Offset(i).Interior.Color = blue
            Range("S15").Offset(i).Interior.Color = override
            
            If inarr(i,12) = "" Then                                     'Blank exhaust cell turns red.
                    If m <> 0 Then
                        Range("M15, R15").Offset(i).Interior.Color = red
                        Else
                            Range("R15").Offset(i).Interior.Color = red
                            Range("M15").Offset(i).Interior.Color = blank
                        End If
                ElseIf (inarr(i,12) + inarr(i,13)) >= m Then              'Check to see if exhaust + return exceed required exhaust
                    Range("R15").Offset(i).Interior.Color = blue
                    Range("M15").Offset(i).Interior.Color = blank
                    Else
                        Range("M15, R15").Offset(i).Interior.Color = yellow                 'Otherwise they are both yellow
                End If


Next i