Better Way to Copy Rows Out of a Loop?

[beartooth91]

So.....the code below works....as long as the copy from sheet is selected. (If the copy to sheet is selected, while running the procedure; nothing is copied.) This is a common problem I've had when copying between sheets and/or workbooks using With Statements. I need to paste values as some of the data contains formulas or lookups. As I said; the code works, but lots of forum readings say you're not supposed to use 'Activate' and 'Select'.

Sub Copy_Master()
'
'Copies point info from Master IO List Workbook to the Imported sheet in the Master Database Workbook
'
Application.ScreenUpdating = False
Call Clear_Imported
Call Open_Master_IO
'
'Count rows of data in NIC Master IO List worksheet
 Dim a As Long, b As Long, entry As Range
 a = Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List").Range("B" & Rows.Count).End(xlUp).Row
'
'Determine start row to paste in Imported worksheet of Master Database Workbook
 '
 'Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List").Range("B11:BP" & a).Copy
 'Workbooks("NIC Master Database.xlsm").Worksheets("Imported").Range("B11:BP" & b).PasteSpecial Paste:=xlPasteValues 'xlPasteAll
 Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List").Activate
 With Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List")
   For Each entry In Range("BP11:BP" & a)
     If entry.Value = "Valid" Then
        b = Workbooks("NIC Master Database.xlsm").Worksheets("Imported").Range("B" & Rows.Count).End(xlUp).Row + 1
        entry.EntireRow.Copy 'Destination:=Workbooks("NIC Master Database.xlsm").Worksheets("Imported").Range("A" & b)
        Workbooks("NIC Master Database.xlsm").Worksheets("Imported").Activate
        Workbooks("NIC Master Database.xlsm").Worksheets("Imported").Range("A" & b).PasteSpecial Paste:=xlPasteValues
        Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List").Activate
     End If
    Next entry
End With
 Application.CutCopyMode = False
 '
End Sub

 

[dmt32]

As I said; the code works, but lots of forum readings say you're not supposed to use 'Activate' and 'Select'.

Information you have found is largely correct, you seldom need to activate a sheet or select a range in code

Done very quickly & not tested but see if this update to your code will do what you want

ub Copy_Master()
    Dim Cell            As Range, rngValid              As Range
    Dim LastRow         As Long
    Dim wbMasterList    As Workbook, wbMasterDatabase   As Workbook
    Dim wsMasterIOList  As Worksheet, wsImported        As Worksheet
    
    On Error GoTo myerror
    
    Application.ScreenUpdating = False
    
    Call Clear_Imported
    Call Open_Master_IO
    
    '------------------------------------------------------------------------------
    '                       SET OBJECT VARIABLES
    '------------------------------------------------------------------------------
    Set wbMasterList = Workbooks("NIC Master IO List.xlsm")
    'or if variable refers to thisworkbook use this line
    'Set wbMasterList = ThisWorkbook
    
    Set wbMasterDatabase = Workbooks("NIC Master Database.xlsm")
    
    Set wsImported = wbMasterDatabase.Worksheets("Imported")
    Set wsMasterIOList = wbMasterList.Worksheets("NIC Master IO List")
    '-----------------------------------------------------------------------------
    
    With wsMasterIOList
        'Count rows of data in NIC Master IO List worksheet
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        
        'loop each cell from Master IO List that matches VALID
        'and combine range(s) into a single range
        For Each Cell In .Range("BP11:BP" & LastRow)
            If UCase(Cell.Value) = UCase("VALID") Then
                If rngValid Is Nothing Then
                    Set rngValid = Cell
                Else
                    Set rngValid = Union(Cell, rngValid)
                End If
            End If
        Next Cell
    End With
    
    'copy & paste all matches in one go
    If Not rngValid Is Nothing Then
        With wsImported
            LastRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
            rngValid.EntireRow.Copy
            .Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues
        End With
        'optional
        'wbMasterDatabase.Save
        'or save & close
        'wbMasterDatabase.Close True
    End If
    
myerror:
    Application.CutCopyMode = False
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

 

[beartooth91]

Dave, your code appears to work. I initially got the 'subscript out of range' error, so moved up one of the lines to fix that. I was going to ask to ask you why you/someone would go to the trouble of writing such complex VBA for this.... One answer - or the answer - is that yours is much faster than mine. Thanks! Final version is below.

Sub Copy_Master2()
    Dim Cell            As Range, rngValid              As Range
    Dim LastRow         As Long
    Dim wbMasterList    As Workbook, wbMasterDatabase   As Workbook
    Dim wsMasterIOList  As Worksheet, wsImported        As Worksheet
    
    On Error GoTo myerror
    Call Open_Master_IO '<----------------- Moved to here
    '------------------------------------------------------------------------------
    '                       SET OBJECT VARIABLES
    '------------------------------------------------------------------------------
    Set wbMasterList = Workbooks("NIC Master IO List.xlsm")
    'or if variable refers to thisworkbook use this line
    'Set wbMasterList = ThisWorkbook
    
    Set wbMasterDatabase = Workbooks("NIC Master Database.xlsm")
    
    Set wsImported = wbMasterDatabase.Worksheets("Imported")
    Set wsMasterIOList = wbMasterList.Worksheets("NIC Master IO List")
    '-----------------------------------------------------------------------------
    
    Application.ScreenUpdating = False
    
    Call Clear_Imported
    'Call Open_Master_IO <--------------Move Up to prevent 'subscript out of range' error
    '
    With wsMasterIOList
        'Count rows of data in NIC Master IO List worksheet
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        
        'loop each cell from Master IO List that matches VALID
        'and combine range(s) into a single range
        For Each Cell In .Range("BP11:BP" & LastRow)
            If UCase(Cell.Value) = UCase("VALID") Then
                If rngValid Is Nothing Then
                    Set rngValid = Cell
                Else
                    Set rngValid = Union(Cell, rngValid)
                End If
            End If
        Next Cell
    End With
    
    'copy & paste all matches in one go
    If Not rngValid Is Nothing Then
        With wsImported
            LastRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
            rngValid.EntireRow.Copy
            .Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues
        End With
        'optional
        'wbMasterDatabase.Save
        'or save & close
        'wbMasterDatabase.Close True
    End If
    
myerror:
    Application.CutCopyMode = False
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

 

[beartooth91]

Dave, your code appears to work. I initially got the 'subscript out of range' error, so moved up one of the lines to fix that. I was going to ask to ask you why you/someone would go to the trouble of writing such complex VBA for this.... One answer - or the answer - is that yours is much faster than mine. Thanks! Final version is below.

Sub Copy_Master2()
    Dim Cell            As Range, rngValid              As Range
    Dim LastRow         As Long
    Dim wbMasterList    As Workbook, wbMasterDatabase   As Workbook
    Dim wsMasterIOList  As Worksheet, wsImported        As Worksheet
   
    On Error GoTo myerror
    Call Open_Master_IO '<----------------- Moved to here
    '------------------------------------------------------------------------------
    '                       SET OBJECT VARIABLES
    '------------------------------------------------------------------------------
    Set wbMasterList = Workbooks("NIC Master IO List.xlsm")
    'or if variable refers to thisworkbook use this line
    'Set wbMasterList = ThisWorkbook
   
    Set wbMasterDatabase = Workbooks("NIC Master Database.xlsm")
   
    Set wsImported = wbMasterDatabase.Worksheets("Imported")
    Set wsMasterIOList = wbMasterList.Worksheets("NIC Master IO List")
    '-----------------------------------------------------------------------------
   
    Application.ScreenUpdating = False
   
    Call Clear_Imported
    'Call Open_Master_IO <--------------Move Up to prevent 'subscript out of range' error
    '
    With wsMasterIOList
        'Count rows of data in NIC Master IO List worksheet
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
       
        'loop each cell from Master IO List that matches VALID
        'and combine range(s) into a single range
        For Each Cell In .Range("BP11:BP" & LastRow)
            If UCase(Cell.Value) = UCase("VALID") Then
                If rngValid Is Nothing Then
                    Set rngValid = Cell
                Else
                    Set rngValid = Union(Cell, rngValid)
                End If
            End If
        Next Cell
    End With
   
    'copy & paste all matches in one go
    If Not rngValid Is Nothing Then
        With wsImported
            LastRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
            rngValid.EntireRow.Copy
            .Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues
        End With
        'optional
        'wbMasterDatabase.Save
        'or save & close
        'wbMasterDatabase.Close True
    End If
   
myerror:
    Application.CutCopyMode = False
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

I'd really like to understand why this is so much faster than the standard For Each loop I had to begin with...... 2767 rows of data to check and copy. My version took 4-5 minutes.....the version from Dave took about 15 seconds! I don't get it.....

 

[dmt32]

I'd really like to understand why this is so much faster than the standard For Each loop I had to begin with...... 2767 rows of data to check and copy. My version took 4-5 minutes.....the version from Dave took about 15 seconds! I don't get it.....

main reasons your code is slower is the time VBA takes to access the worksheet for each copying & paste action that matches the criteria you were performing in the For Next Loop.

Doing this over many 000’s of iterations can, as you have found out, prove to be very slow. To speed this up, you need to minimise the number of accesses to the worksheet in code & one of the ways to do this is to first build the range of non-contiguous cells that match your criteria using the Union method to make one single range. You then perform the copy paste action in one action hence the speed improvement.

Another faster method would be to read the entire range in to a variant array and check this for criteria matches but Union method performs ok in most cases.

BTW - I realised the error & corrected & moved the code below within the 10 min rule after posting.

Call Open_Master_IO '<----------------- Moved to here

You did not share this code but as it opens the Master workbook it would probably be better as a function which would negate need of hard coding the workbook name in main code.
If you want to share the code I will have a look at it & see if can be updated.

Dave

 

[Peter_SSs]

My version took 4-5 minutes.....the version from Dave took about 15 seconds!

What about this one?

1. Does it do what you want?
2. If so, how does it go for timing?

Sub Copy_Master_v2()
  Dim wsMasterlist As Worksheet, wsMasterDatabase As Worksheet

  Application.ScreenUpdating = False
  
  Call Clear_Imported
  Call Open_Master_IO
  
  Set wsMasterlist = Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List")
  Set wsMasterDatabase = Workbooks("NIC Master Database.xlsm").Worksheets("Imported")
  With wsMasterlist
    With Intersect(.UsedRange, .Range("A10", .Range("B" & Rows.Count).End(xlUp)).EntireRow)
      .AutoFilter Field:=68, Criteria1:="Valid"
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).Copy
        wsMasterDatabase.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues
      End If
    End With
    .AutoFilterMode = False
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

 

[beartooth91]

What about this one?

1. Does it do what you want?
2. If so, how does it go for timing?

Sub Copy_Master_v2()
  Dim wsMasterlist As Worksheet, wsMasterDatabase As Worksheet

  Application.ScreenUpdating = False
 
  Call Clear_Imported
  Call Open_Master_IO
 
  Set wsMasterlist = Workbooks("NIC Master IO List.xlsm").Worksheets("NIC Master IO List")
  Set wsMasterDatabase = Workbooks("NIC Master Database.xlsm").Worksheets("Imported")
  With wsMasterlist
    With Intersect(.UsedRange, .Range("A10", .Range("B" & Rows.Count).End(xlUp)).EntireRow)
      .AutoFilter Field:=68, Criteria1:="Valid"
      If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).Copy
        wsMasterDatabase.Range("B" & Rows.Count).End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues
      End If
    End With
    .AutoFilterMode = False
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

This one appears to work as well, and is also very fast. The only issue is that, after running it; I can't scroll across or down to the end columns/rows unless I unfreeze panes.

 

[Peter_SSs]

after running it; I can't scroll across or down to the end columns/rows unless I unfreeze panes.

I have not been able to reproduce that problem.
Which sheet(s) has freeze panes applied and exactly where are the panes frozen so I can test some more?

 

[beartooth91]

main reasons your code is slower is the time VBA takes to access the worksheet for each copying & paste action that matches the criteria you were performing in the For Next Loop.

Doing this over many 000’s of iterations can, as you have found out, prove to be very slow. To speed this up, you need to minimise the number of accesses to the worksheet in code & one of the ways to do this is to first build the range of non-contiguous cells that match your criteria using the Union method to make one single range. You then perform the copy paste action in one action hence the speed improvement.

Another faster method would be to read the entire range in to a variant array and check this for criteria matches but Union method performs ok in most cases.

BTW - I realised the error & corrected & moved the code below within the 10 min rule after posting.

Call Open_Master_IO '<----------------- Moved to here

You did not share this code but as it opens the Master workbook it would probably be better as a function which would negate need of hard coding the workbook name in main code.
If you want to share the code I will have a look at it & see if can be updated.

Dave

I've been studying this and am losing it, here, with the entire rngValid - Is Nothing - Else lines.......
My questions below in the code snip.

  'loop each cell from Master IO List that matches VALID
        'and combine range(s) into a single range
        For Each Cell In .Range("BP11:BP" & LastRow)
            If UCase(Cell.Value) = UCase("VALID") Then
                If rngValid Is Nothing Then '<--- Are we saying that if rngValid is not associated Then
                    Set rngValid = Cell  '<--- Add the first valid cell into the array range? If 'yes', I'd think that's true for only the first pass.....?
                Else
                    Set rngValid = Union(Cell, rngValid)  '<----Does this then become true after the first pass?
                End If
            End If
        Next Cell

 

[dmt32]

The VBA Union method in Excel is designed to combine ranges into a single range. You use Union to combine multiple ranges based on a common criterion as in your case, cell values that match criteria “Valid”
However, Union method cannot combine ranges if one of the ranges does not exist therefore, until object variable rngValid is defined the first time, you cannot include it in Union statement.

To do this, you include a if statement to test each cell in the range

If rngValid Is Nothing Then

And use the set statement to add it to the range

Set rngValid = Cell

Now after the range is defined the first time, you add to the existing range(s) with the Union command to build a single range.

Set rngValid = Union(Cell, rngValid)

You can read more in VBA help file if needed.

Union method is sufficient in many cases but there are, as @Peter_SSs has shown, still much quicker methods to produce required result if needed.

Hope Helpful

Dave