excel macro overflow problem

[tuytuy]

hi,
i have a table of 91400 rows and i've tried to run this macro, but it always gets suck and ends up not responding. The original code had integer instead of long, i though by changing this it would help, but it doesn't seem to change anything...

Sub SheetBBM ()
'Creating BlackBerry table


Sheets.Add.Name = "BlackBerry"
ActiveWorkbook.Sheets("Section_14").Activate
Dim LSearchRow As Long
   Dim LCopyToRow As Long
   'Start search in row 3
   LSearchRow = 3
   
   'Start copying data to row 2 in Sheet2 (row counter variable)
   LCopyToRow = 2
   
   While Len(Range("A" & CStr(LSearchRow)).Value) > 0
   
      'If value in column E = "Mail Box", copy entire row to Sheet2
      If Range("K" & CStr(LSearchRow)).Value = "BlackBerry usage" Then
      
         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy
         
         'Paste row into Sheet2 in next row
         Sheets("BlackBerry").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste
         
         'Move counter to next row
         LCopyToRow = LCopyToRow + 1
         
         'Go back to Sheet1 to continue searching
         Sheets("Section_14").Select
         
      End If
      
      LSearchRow = LSearchRow + 1
      
   Wend
   
   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select
End sub

 

[VoG]

Which line causes the error?

Incidentally I think that you could replace

         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select          
Selection.Copy                    
'Paste row into Sheet2 in next row          
Sheets("BlackBerry").Select          
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select          
ActiveSheet.Paste

with

Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy Destination:=Sheets("BlackBerry").Rows(CStr(LCopyToRow))

 

[jim may]

Are the CStr()'s necessary? not sure here... just something to consider

 

[tuytuy]

LSearchRow = LSearchRow + 1

is where i get the error</pre>

 

[RoryA]

That shouldn't happen if you declare it as Long rather than Integer.

Try:

Sub SheetBBM()
'Creating BlackBerry table


   Dim LSearchRow             As Long
   Dim LCopyToRow             As Long


   With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
   End With
   Sheets.Add.Name = "BlackBerry"


   'Start search in row 3
   LSearchRow = 3


   'Start copying data to row 2 in Sheet2 (row counter variable)
   LCopyToRow = 2
   With ActiveWorkbook.Sheets("Section_14")
   
      While Len(.Range("A" & LSearchRow).Value) > 0


         'If value in column E = "Mail Box", copy entire row to Sheet2
         If .Range("K" & LSearchRow).Value = "BlackBerry usage" Then


            'Select row in Sheet1 to copy
            .Rows(LSearchRow).Copy Sheets("BlackBerry").Cells(LCopyToRow, "A")


            'Move counter to next row
            LCopyToRow = LCopyToRow + 1


         End If


         LSearchRow = LSearchRow + 1


      Wend


      'Position on cell A3
      .Activate
      .Range("A3").Select
   End With


   With Application
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
   End With


End Sub

 

[tuytuy]

ok thx for your help i'm trying it right know and letting you know