Loop Stops Early

[RyanTG]

Hi everyone

Spent hours trying to figure out why this loop stops early (Row 48,577).

I tried many solutions from the forum with no success.

Here is the simple table I am using to copy/paste data:

Excel Workbook
	A	B	C	D	E
1	gm_accountno	name	property_string	Account	Identifier
2	A6022438593%A_/?CityOntarioA6022438593%A_/?
3	A6022438593%A_/?Notes*** TODD (Todd Viani) *** November 19, 2015 at 2:17pmA6022438596(3U&X
4	A6022438593%A_/?StateCAA6022438596%PQ={
5	A6022438593%A_/?A6022438598&/U$U
6	A6022438593%A_/?A6022438598$=9^M
7	A6022438596(3U&XA6022438598(%:7
SortDateHere

There is nothing different about the data when it stops, so that is not causing it. The table I am using has around 270,000 rows.

Below is the code I am using to parse the data:

Sub ExtractIdentifier()


      
Dim x                       As Long
Dim MyTimer                 As Double
Dim booStatusBarState       As Boolean
Dim iMax                    As Long
Dim i                       As Long




    iMax = 264273
    Application.ScreenUpdating = False
    booStatusBarState = Application.DisplayStatusBar
    Application.DisplayStatusBar = True


Range("A2").Select




    For i = 1 To iMax
        fractionDone = CDbl(i) / CDbl(iMax)
        Application.StatusBar = Format(fractionDone, "0%") & " done..."
        
            'TWO LINES ABOVE ARE FOR THE STATUS BAR
            
            'BELOW: To Copy Account #


               If ActiveCell = ActiveCell.Offset(-1, 0).Range("Table4[[#Headers],[gm_accountno]]") Then
                        
                    Else
                        
                        ActiveCell.Offset(1000000, 3).End(xlUp).Offset(1, 0).Value = ActiveCell.Value
                        ActiveCell.Select
                            
               
                End If
            
                 
            'BELOW: To Copy Identifier
            
                If ActiveCell.Offset(0, 1) = "Identifier" Then
            
                            ActiveCell.Offset(1000000, 3).End(xlUp).Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value
                            ActiveCell.Select
            
                    
                End If
              
            
        'NEXT LINE
        
            ActiveCell.Offset(1, 0).Select
        
        
        DoEvents
              


    Next i
    


        Application.DisplayStatusBar = booStatusBarState
    ''//Reset Status bar display setting
        Application.StatusBar = False
    ''//Return control of the Status bar to Excel
        Application.ScreenUpdating = True
    ''//Turn on screen updating




End Sub

I get error: Run Time 1004


1. Excel 2010; Windows 7 Pro

2. PC

 

[Jerry Sullivan]

Hi Ryan,

Worksheets in Excel 2007 and later have 1048576 rows.

An error will occur at this expression when the ActiveCell is on Row 48577

ActiveCell.Offset(1000000, 3)

...since VBA can't evaluate Cells(1048577,3)

There's no need to use Select and ActiveCell to step through and process a range of cells. It's much more efficient and to reference the objects directly without selecting them.

 

[RyanTG]

That makes sense! How would I apply that concept of referencing objects directly without selecting them?

Because I am new, this is the most efficient code I could think of.

Thanks for your patience in advance!

 

[RyanTG]

Is this what you mean?

Dim Rows                    As Range

Set Rows = Range("d94564")

 

[RyanTG]

'BELOW: To Copy Company
            
                If ActiveCell.Offset(0, 1) = "Company" Then
            
                        Rows.End(xlUp).Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value
                                       
                End If

 

[Dryver14]

where exactly are you trying to go from the active cell

ActiveCell.Offset(1000000, 3).End(xlUp).Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value
ActiveCell.Select

 

[RyanTG]

Everything is based on the account # because it is unique. I want that to go to Row D. The code above is to copy the company (column D) in its associated account #,

Changing the code fixed the loop issue. Is there a more efficient way to do this?

Sub ExtractCallBack()


      
Dim x                       As Long
Dim MyTimer                 As Double
Dim booStatusBarState       As Boolean
Dim iMax                    As Long
Dim i                       As Long


'UPDATE iMAX according to number of rows you want to process


    iMax = 68470
    Application.ScreenUpdating = False
    booStatusBarState = Application.DisplayStatusBar
    Application.DisplayStatusBar = True


Range("A2").Select




    For i = 1 To iMax
        fractionDone = CDbl(i) / CDbl(iMax)
        Application.StatusBar = Format(fractionDone, "0%") & " done..."
        
            'TWO LINES ABOVE ARE FOR THE STATUS BAR
            
            'BELOW: To Copy Account #


               If ActiveCell = ActiveCell.Offset(-1, 0) Then
                        
                    Else
                        
                        Range("d68470").End(xlUp).Offset(1, 0).Value = ActiveCell.Value
               
               End If
            
            'BELOW: To Copy Company
            
                If ActiveCell.Offset(0, 1) = "Company" Then
            
                            Range("d68470").End(xlUp).Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value
                                       
                End If
                
            'BELOW: To Copy Contact
            
                If ActiveCell.Offset(0, 1) = "Contact" Then
            
                            Range("d68470").End(xlUp).Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value
                             
                End If
            
                 
            'BELOW: To Copy Notes
            
                If ActiveCell.Offset(0, 1) = "Notes" Then
            
                            Range("d68470").End(xlUp).Offset(0, 3).Value = ActiveCell.Offset(0, 2).Value
                                                 
                End If
                
            'BELOW: To Copy CallBack
            
                If ActiveCell.Offset(0, 1) = "Callbackon" Then
            
                            Range("d68470").End(xlUp).Offset(0, 4).Value = ActiveCell.Offset(0, 2).Value
                          
                End If
              
            
        'NEXT LINE
        
            ActiveCell.Offset(1, 0).Select
        
        
        DoEvents
              


    Next i
    


        Application.DisplayStatusBar = booStatusBarState


        Application.StatusBar = False


        Application.ScreenUpdating = True
 




End Sub

 

[Jerry Sullivan]

Ryan, By "directly reference the objects without selecting them", I didn't mean to imply you should hard-code address references. I meant "don't select the cells, reference them using variables".

Here's an example doing that....

 With ActiveSheet
   lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

   For lRow = 2 To lLastRow
      fractionDone = CDbl(lRow) / CDbl(lLastRow)
      Application.StatusBar = Format(fractionDone, "0%") & " done..."
      
      If .Cells(lRow, "A").Value <> .Cells(lRow - 1, "A").Value Then
         .Cells(.Rows.Count, "D").End(xlUp).Offset(1) = .Cells(lRow, "A").Value
                   
      '-your other if statements
      ' ....
      ' ....

                   
      End If
    Next lRow
 End With

I didn't completely understand whether the data you copy to Columns D:H is supposed to directly relate to the data in Columns A:B on the same row.

It looks like your desired result would is to have all the data compressed in Columns D:H, so that you might have 270,000 rows of data in A, and only the first ~80K rows of D:H would have the extracted info. Is that correct? The process of continually finding the last row of data in Column D is not ideal if those are supposed to be aligned.

Is there a more efficient way to do this?

The method of referencing cells without selecting them is more efficient than the code in your OP, but it isn't the most efficient.
Much better would be to process the data in arrays to minimize the number of reads and writes to the sheet.

For your VBA learning, I'd suggest you start by modifying the rest of your code to follow my example above. After that's working, we can take that a step further to make that run even faster.

 

[RyanTG]

You have been extraordinarily helpful!

Thank you kind sir