Macro run time error

[LopezGG]

Hi,

I have a peice of code that filters a column for zero values and returns the rowcount. I tried looping over different columns.this macro works well with small input.
But I have an excel sheet with 160106 rows. I want to run my macro on this . I am getting a run 1004 error.I found the following link which kind of explains the problem
http://support.microsoft.com/kb/210684

But I am not able to resolve it. Could anyone please help me. I am pasting my macro below

my sample file is in, it is a 96mb file

Option Explicit
Sub findrcn()
Dim wsStart As Worksheet
Dim sWord As String
Dim RowCount As Integer
Dim i As Long
Dim j As Long
Dim l As Long
Dim k As String
Dim Final As Integer
Dim lastrow As Integer
Dim rng As Range




    Set wsStart = ActiveSheet
    'this loop is to check if a sheet exists
        For j = 1 To Worksheets.Count
        k = Worksheets(j).Name
        If UCase(k) = UCase("Analysis") Then
            lastrow = ((Sheets("Analysis").Range("A" & Rows.Count).End(xlUp).Row) + 1)
        Else
            lastrow = 0
        End If
            
        Next j
        MsgBox "finished checking the sheets"
           
For Each rng In Range("A1:B1").Columns
        sWord = Replace(rng.Address(RowAbsolute:=False), "$", "")    ''Now I am trying to loop over all the columns  
        If lastrow = 0 Then
                Sheets.Add After:=Sheets(Sheets.Count)'Adding a new sheet
                Sheets(Sheets.Count).Name = "Analysis"
                wsStart.AutoFilterMode = False

                    With wsStart
                        .Range(sWord).AutoFilter Field:=1, Criteria1:="=0"'if my column contains a 0 in it filter that
                        
                            With .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
                            Final = .Count 'get the count of the number of rows after the filter
                            RowCount = Final - 1
                            MsgBox RowCount
                            End With
                            
                           Sheets("Analysis").Range("A") = RowCount 'paste it in the analysis tab
                                                     
                    End With
                    wsStart.AutoFilterMode = False
                    
                    
        Else
              
            wsStart.AutoFilterMode = False
                    
                    
                    With wsStart
                        .Range(sWord).AutoFilter Field:=1, Criteria1:="=0" 'if my column contains a 0 in it filter that
                            MsgBox sWord
                            With .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
                            Final = .Count
                            MsgBox "final"
                            RowCount = Final - 1 ' to account for column name
                            MsgBox RowCount
                            End With
                            
                           Sheets("Analysis").Range("A" & lastrow) = RowCount 'paste it in the analysis tab
                                 
                            
                    End With
                    wsStart.AutoFilterMode = False
                    MsgBox "I am editing the existing sheet"
                    
            
        End If
Next rng

End Sub

[Blazej]

You will get this error of one or more cells in the array have a character string which is put to hold over 911 characters. To resolve this problem, you will have to edit the script such that no cell within the array holds the character sting of over 911 characters. I hope that this will help you resolve the error.

[LopezGG]

Thank you ! Got it done

the code is

Option Explicit
Public Sub TallyZerosOnActiveSheet()

   Dim SourceSh As Worksheet
   Dim CurrentCountRange As Range
   Dim ETOHCountRange As Range
   Dim ZeroCount As Long
   Dim ETOHcount As Long
   Dim Biocount As Long
   Dim ETOHBiocount As Long
   
   Dim NextRow As Long
   Dim iRow As Long
   Dim ColWithHdr
   
    ' CONFIG HERE !!
   Const analysisSh As String = "Analysis"
   Const SrcHdrRow As Integer = 1
   
  NextRow = 160108
   'Set Source Sheet
   Set SourceSh = ActiveSheet
   
   'Make sure Anlaysis Sheet Exist
   If Not SheetExists(analysisSh) Then
      Sheets.Copy after:=ActiveSheet
      ActiveSheet.Name = analysisSh
   End If
   
   With SourceSh
       ' Cycle thru all columns that have header
      For Each ColWithHdr In .Rows(SrcHdrRow & ":" & SrcHdrRow).SpecialCells(xlCellTypeConstants, 2)
         
         ' Set range to count
         Set CurrentCountRange = .Cells(1, ColWithHdr.Column).EntireColumn
         'Set ETOHCountRange = .Cells(1, 1).EntireColumn
            
         ' Count zeros
         ZeroCount = Application.WorksheetFunction.CountIf(CurrentCountRange, 0)
         ETOHcount = 0
         Biocount = 0
         ETOHBiocount = 0
         For iRow = 1 To 160106
            If Cells(iRow, ColWithHdr.Column) = 0 Then
                
                If Not (Cells(iRow, 1) = 0) Then
                    ETOHcount = ETOHcount + 1
                End If
                If Not (Cells(iRow, 68) = 0) Then
                    Biocount = Biocount + 1
                End If
                If Not ((Cells(iRow, 68) = 0) Or (Cells(iRow, 1) = 0)) Then
                        ETOHBiocount = ETOHBiocount + 1
                End If
            End If
        Next iRow
                
         ' Log Zeros
         With Sheets(analysisSh)
            'NextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            NextRow = NextRow + 1
            .Cells(NextRow, 1).Value = ColWithHdr.Value
            .Cells(NextRow, 2).Value = ZeroCount
            .Cells(NextRow, 3).Value = ETOHcount
            .Cells(NextRow, 4).Value = Biocount
            .Cells(NextRow, 5).Value = ETOHBiocount
         End With
         
      Next ColWithHdr
   End With
End Sub


Private Function SheetExists(sname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function