Firefox Extension: Macro run time error

Macro run time error
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

Code:

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

Reply With Quote
#2
Old 13-04-2011
Blazej's Avatar
Blazej Blazej is offline
Member

Join Date: May 2008
Posts: 863
Re: Macro run time error
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.
Reply With Quote
#3
Old 13-04-2011
LopezGG LopezGG is offline
Member

Join Date: Apr 2011
Posts: 2
Re: Macro run time error
Thank you ! Got it done

the code is

Code:

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

Reply With Quote