Evaluate Range of Cell

[halem2]

Hi:

I have an extremely large wb with hundreds of ws. All ws' have the
same format.
I need to evaluate all cells in range F25:R29 and if the value of the
cell has a number > 0 then go to the next. If the value is blank then
insert a zero. I have been using the code below but for for some
reason, after 20 ws' or so, it starts writting zeros in other cells.

Any help is welcome.

Sub makeZero()
For Each SH In ActiveWorkbook.Worksheets
SH.Activate

Range("F21").Activate
For i = 1 To 13
If ActiveCell = "" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell = "N/A" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell <> 0 Then
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell = 0 Then
ActiveCell.Offset(0, 1).Select
End If
Next i

'''''''''''''''''''''

Range("F25").Activate

For i = 1 To 13
If ActiveCell = "" Then
ActiveCell = 0
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = "N/A" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell <> 0 Then
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = 0 Then
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell = "" Then
ActiveCell = 0
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = "N/A" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell <> 0 Then
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = 0 Then
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell = "N/A" Then
ActiveCell = 0
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = "" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell <> 0 Then
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = 0 Then
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell = "" Then
ActiveCell = 0
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = "N/A" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell <> 0 Then
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell = 0 Then
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell = "" Then
ActiveCell = 0
ActiveCell.Offset(-4, 1).Select
ElseIf ActiveCell = "N/A" Then
ActiveCell = 0
ActiveCell.Offset(0, 1).Select
ElseIf ActiveCell <> 0 Then
ActiveCell.Offset(-4, 1).Select
ElseIf ActiveCell = 0 Then
ActiveCell.Offset(-4, 1).Select
End If

Next i

Next

End Sub

 

[Norman Jones]

Hi Halem2,

Try:

'================>>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim rCell As Range
Dim CalcMode As Long
Const sAdd As String = "F25: R29"

Set WB = Workbooks("YourBook.xls") '<<===== CHANGE

On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each SH In WB.Worksheets
On Error Resume Next
Set rng = SH.Range(sAdd).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

If Not rng Is Nothing Then
rng.Value = 0
End If

Next SH

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<================

 

[Norman Jones]

Hi Halem,

You can delete:

Dim rCell As Range

which represents an unused variable,