Odtnhj

Hi I am trying to add formulas to specific ranges on each worksheet in my workbook, however when i run it does not work properly.

The formulas are functions that help count the number of cells that meet a certain criteria.

 Sub Formatting()
For rcell = 1 To lrow
CharacterIndex = InStr(1, sourceSheet.Cells(rcell, Col_Western), "Delivery for Creative", vbBinaryCompare)
If CharacterIndex > 0 Then
On Error Resume Next
deliveryname = "CS"

With ThisWorkbook.Worksheets.add
.Name = deliveryname
sourceSheet.Range(sourceSheet.Cells(rcell, Col_Western), sourceSheet.Cells(lastrow, Col_phone).End(xlDown)).Copy .Range("A1")
Cells.Select
Selection.RowHeight = 50
Selection.ColumnWidth = 30
'Add Autofilter to Row above student details
Range("a8:e8").EntireRow.AutoFilter
End With
End If

Next rcell



For Each Grey_ws In ThisWorkbook.Worksheets
Call Grey_VALUE_AND_RANGE_ALL(Grey_ws)
'do nothing else
Next Grey_ws

End Sub

Sub Grey_VALUE_AND_RANGE_ALL(Grey_ws As Worksheet)
 With Grey_ws
 .Range("A5").FormulaR1C1 = "=Count_items_SmallWest()"
 .Range("A6").FormulaR1C1 = "=Count_items_LargeWest()"
 .Range("B5").FormulaR1C1 = "=Count_items_Small_Asian()"
 .Range("B6").FormulaR1C1 = "=Count_items_Large_Asian()"
 .Range("C5").FormulaR1C1 = "=Count_items_Small_Veg()"
 .Range("C6").FormulaR1C1 = "=Count_items_Large_Veg()"
 .Range("D5:D6").FormulaR1C1 = "=Count_items_Salad()"
 .Range("E5:E6").FormulaR1C1 = "=Count_items_Dessert()"
 .Range("F5:F6").FormulaR1C1 = "=Count_items_Snack()"
 End With
End Sub

I suspect the user-defined functions used by your formulas are invoked as your code executes, perturbating the loop; it is also possible that the Worksheet_Change event handler, if it exists, interferes with your loop.

In your Formatting sub, sandwich the For loop between Application.Calculation and Application.EnableEvents as follows:

Sub Formatting()
 Dim Grey_ws as Worksheet

 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False

 For Each Grey_ws In ThisWorkbook.Worksheets
 Call Grey_VALUE_AND_RANGE_ALL(Grey_ws)
 Next Grey_ws

 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
End Sub

This will let Excel know it shouldn't calculate any formula results, nor emit any events, while the loop executes.

To stay on the safe side, make sure to re-establish calculations and events in case of error:

Sub Formatting()
 Dim Grey_ws As Worksheet
 Dim lInitialCalculation As XlCalculation
 Dim bInitialEnableEvents As Boolean

 On Error GoTo ErrorHandler

 lInitialCalculation = Application.Calculation
 Application.Calculation = xlCalculationManual

 bInitialEnableEvents = Application.EnableEvents
 Application.EnableEvents = False

 For Each Grey_ws In ThisWorkbook.Worksheets
 Call Grey_VALUE_AND_RANGE_ALL(Grey_ws)
 Next Grey_ws

Cleanup:
 On Error Resume Next '<== important to prevent an infinite error loop, should the cleanup code fail.
 If Application.EnableEvents <> bInitialEnableEvents Then
 Application.EnableEvents = bInitialEnableEvents
 End If
 If Application.Calculation <> lInitialCalculation Then
 Application.Calculation = lInitialCalculation '<== back to the initial value.
 End If

 Exit Sub

ErrorHandler:
 MsgBox Err.Description, vbExclamation + vbOKOnly '<== or whatever you see fit.
 GoTo Cleanup
End Sub