Optimize UDF - Cell Color Counter - VBA

[RaisedByWolves]

I have a workbook with a main control sheet and 40-50 different data sheets that are copy/paste valued into the file from an external source (each sheet has anywhere from 30 to 500 rows and 10 to 100 columns with data).


The purpose of the workbook is to compare cells in various data sheet columns and highlight them if they fit a certain variance criteria; the highlighted cells on each data sheet are then counted and displayed on the main control sheet (using UDF formulas).


After reading the cpearson site, I realized that counting highlighted cells was nearly impossible if you used traditional conditional formatting... but I only figured this out after I had already written the custom CF code in VBA for 40+ sheets (this was done so that formatting could be removed or applied with a macro button after the data sheets had been "refreshed" using copy/paste).


So after a nice long cry, I essentially recreated conditional formatting (again in VBA) using looping to achieve my goal.


----------------------------------------------------------------------------------------------------------------------------------------------


Example criteria: 25% less than or greater than the cell value compared.


Example Data Sheet:

[col 1] *** [col 2]
2014 *****2015
1 *********1.1
3 **********3
532 *******555
323 *******46 *this value would highlight
<this value="" would="" highlight
<this would="" highlight
42 *******-112 <this would="" highlight
*this value would highlight

(The highlighting would occur if cells in col 2 are either 25% greater or less than the cells in col 1 cell for the corresponding row.)


asterisks are only used for the purpose of spacing the two columns in this example

Example code:

Dim ref As WorksheetDim wkb As Workbook
    
    Set wkb = ThisWorkbook
    Set ref = ThisWorkbook.Sheets("Reference")
    pn1 = ref.Range("E17").Value




    With wkb.Sheets(pn1)
    .Select
        
Set e1 = wkb.Sheets(pn1)
       
 For i = 7 To 53
 j = 2
 k = j + 8




        If e1.Cells(i, j).Value > 0 And IsNumeric(e1.Cells(i, j).Value) = True _
        Then If e1.Cells(i, j).Value > 1.25 * e1.Cells(i, k).Value _
    Or e1.Cells(i, j).Value < 0.75 * e1.Cells(i, k).Value _
        Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181)




    If e1.Cells(i, j).Value < 0 And IsNumeric(e1.Cells(i, j).Value) = True _
        Then If e1.Cells(i, j).Value < 1.25 * e1.Cells(i, k).Value _
    Or e1.Cells(i, j).Value > 0.75 * e1.Cells(i, k).Value _
        Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181)
        
    Next i


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 For i = 7 To 53
 j = 2
 k = j + 9




    If e1.Cells(i, j).Value > 0 And IsNumeric(e1.Cells(i, j).Value) = True _
        Then If e1.Cells(i, j).Value > 1.25 * e1.Cells(i, k).Value _
    Or e1.Cells(i, j).Value < 0.75 * e1.Cells(i, k).Value _
        Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181)




    If e1.Cells(i, j).Value < 0 And IsNumeric(e1.Cells(i, j).Value) = True _
        Then If e1.Cells(i, j).Value < 1.25 * e1.Cells(i, k).Value _
    Or e1.Cells(i, j).Value > 0.75 * e1.Cells(i, k).Value _
        Then e1.Cells(i, j).Interior.Color = RGB(252, 213, 181)
        
    Next i




    End With
        
End Sub

(There are often blank columns between populated data columns and hidden rows scattered throughout the sheets)




I then created a UDF to fit my counting needs:

Function CountRed(MyRange As Range) As Integer                                       
'Application.Volatile                                                          
CountRed = 0                                                                    
For Each cell In MyRange                                                        
If Not cell.EntireRow.Hidden And cell.Interior.Color = RGB(252, 213, 181) 
CountRed = CountRed + 1                                                         
End If                                                                          
Next cell
End Function

I have two main issues:


1. When the conditional formatting is applied, the cell displaying the UDF formula (=CountRed[WkshtName]{Range:Range}) does not automatically update; this being the case even if "application.volatile" is active for the UDF and the workbook is set to automatic calculation.


2. Speed.


With these two conditions in mind (application.volatile and automatic calculation), the highlighted cell count number (output of the UDF formula) will only update if I click one of the UDF formula cells and press F9 (or I can click the formula bar and press enter), but the bigger problem is that my workbook times out for a solid 4-5 minutes while it updates ALL of the UDF formulas on my page (this is my assumption based on quicker processing times with less UDF formulas on the page or smaller range criteria used in the UDF formulas). *Turning off application.volatile and leaving automatic calculation on yields similar results.


To combat this I have turned OFF both automatic calculation and application.volatile (this seemingly has no effect either way).


I know this method will not allow for any type of automatic updating of the output UDF formula (highlighted cell count number), but the manual recalculation (F9 or formula "enter") of each UDF formula now only takes 5-10 seconds depending on the range size (it will also only update the cell you clicked on).


My main hiccup here occurs when I try and include a click button macro that forces an update of the whole page to eliminate the need for updating each UDF formula cell (ex. ThisWorkbook.Worksheets("Reference").Calculate), my calculation time then slows back down near the original updating times (3-4 minutes) and leaves me questioning if it is really that much faster after all.


All of that leads me to ask...


Is there was any way to optimize or speed up the looping/processing time of my custom UDF?


Automatic updating would be icing on the cake, but if I have to force a manual recalculation then I would love for it to be as fast as possible.


------------------------------------------------------------------------------------------------------------------------------------------------------------------


Please let me know if I need to clarify anything, or take screen shots of my workbook/code (I apologize in advance if my explanation is fairly convoluted; I have been using VBA for a limited time and am certainly still a novice).


Note: I am using Excel 2007.






THANK YOU IN ADVANCE !!</this></this></this>

 

[Jerry Sullivan]

Welcome to MrExcel,

One possibility would be to use worksheet formulas to calculate the cells that meet the criteria in lieu of counting the cells that have a color.
You would still color the cells so the user could easily identify that cells - using either VBA or your original Conditional Formatting that you worked so hard to create.

If your criteria all take the form of being outside of an acceptable variance range as in your example, then the counts could be calculated with Sumproduct formulas on your summary sheet. To further speed calculations, a helper column could be added to each sheet that had evaluate to 1 for each record that meets the criteria and 0 for those that don't.
Your summary sheet could then simply Sum those columns.