Advanced Filter Data Transfer Speed / Overwrite Issue

[Lil Stinker]

Hey folks,
I'm looking for a way to copy the results from an AdvancedFilter run on Sheet1 to Sheet2. The code I currently have works to copy the data over however, it overwrites any existing data on Sheet2. My other issue with this is that for my sample of 196 rows of data (15 columns), it is taking approx. 24 seconds to run which is exceedingly long.

What I would like for it to do is copy over the result data to Sheet2 without overwriting any existing data. And preferably faster as it is intended to run in the background without the user's knowledge. I have tried deleting the Advanced Filter's criteria and extract ranges from the Named Manager as well as disabling ScreenUpdating, EnableEvents and turned Calculation to manual prior to running the code again but all of that seems to increase the amount of time. In fact, doing so actually locks up Excel entirely to where I get the (Excel Not Responding) message. I have also tried simply changing the Advanced Filter's CopyTo:= range to Sheet2 but that too overwrites everything.

I have established the last row and last result row on Sheet1 when the filter runs but when I try to establish a last row for Sheet2, all I seem to get is one new row of #N/A. Here is the code, any help would be appreciated:

Sub INV_historyfilter()
Dim lastNEWITEM As Long, HSTrow As Long, HSTcol As Long

   advINVHISTfilterCLEAR 'clears adv filter criteria and extract ranges
    With Inventory 'sheet1
      lastROW = .Range("A1048576").End(xlUp).Row + 1 'last item row
      If lastROW < 3 Then GoTo NoNew
         .Range("A2:Q" & lastROW).AdvancedFilter xlFilterCopy, .Range("CD1:CD2"), .Range("CF2:CV2"), Unique:=True
      lastRESULTROW = .Range("CF99999").End(xlUp).Row
      If lastRESULTROW < 3 Then GoTo NoNew

      '''copy results to history sheet'''
      'HSTrow = Inventory1.Range("Q1048576").End(xlUp).Row + 1 'last item row <---tried replacing lastNEWITEM with HSTrow below--results in row of #N/A's
      For lastNEWITEM = 3 To lastRESULTROW
         Inventory1.Range("A3:O" & lastNEWITEM).Value = .Range("CF3:CT" & lastRESULTROW).Value 'copy over filtered results
         Inventory1.Range("P" & lastNEWITEM).Value = Date
         Inventory1.Range("Q" & lastNEWITEM).Value = "=Row()"
      Next lastNEWITEM
   End With
NoNew:

End Sub

 

[DanteAmor]

Reviewing your code, I assume the following:

1. The headers are in row 2.
.Range("A2:Q" & lastROW).AdvancedFilter

2. This line clears the CF:CV data starting at row 2 and down.

advINVHISTfilterCLEAR ​

If the above is correct, then try this:

Sub INV_historyfilter()
  Dim lr As Long, lastROW As Long
    
  advINVHISTfilterCLEAR 'clears adv filter criteria and extract ranges
  With Inventory 'sheet1
    lastROW = .Range("A" & Rows.Count).End(xlUp).Row 'last item row
    If lastROW < 3 Then Exit Sub
    
    .Range("A2:Q" & lastROW).AdvancedFilter xlFilterCopy, .Range("CD1:CD2"), .Range("CF2:CV2"), Unique:=True
    lr = .Range("CF" & Rows.Count).End(xlUp).Row
    If lr < 3 Then Exit Sub
    
    .Range("CU3:CU" & lr).Value = Date
    .Range("CV3:CV" & lr).Value = "=Row()"
    Inventory1.Range("A" & Rows.Count).End(3)(2).Resize(lr - 2, 17).Value = .Range("CF3:CV" & lr).Value
  End With
End Sub

 

[Lil Stinker]

Thank you for this! It works way better than what I was trying to do, that's for sure. However, there is one thing I need to tweak and I'm not sure how to go about doing that.

.Range("CU3:CU" & lr).Value = Date

.Range("CV3:CV" & lr).Value = "=Row()"

I see you are adding the Date and Row() to the original Inventory sheet before copying the results over to Inventory1, however I assume you meant ("CW3:CW" & lr) for the Date column and ("CX3:CX" & lr) for the Row() column since CU and CV are already included in the CopyToRange of the Advanced Filter? Otherwise, it overwrites the existing data in those columns.

The problem with adding the Row() before copying the result data over is that I need it to reflect the Row() of Inventory1, not the Row() from the original Inventory sheet. How can I get Row() to populate for each new row of data added to Inventory1 during this macro?

 

[DanteAmor]

Thank you for this! It works way better than what I was trying to do, that's for sure. However, there is one thing I need to tweak and I'm not sure how to go about doing that.



I see you are adding the Date and Row() to the original Inventory sheet before copying the results over to Inventory1, however I assume you meant ("CW3:CW" & lr) for the Date column and ("CX3:CX" & lr) for the Row() column since CU and CV are already included in the CopyToRange of the Advanced Filter? Otherwise, it overwrites the existing data in those columns.

The problem with adding the Row() before copying the result data over is that I need it to reflect the Row() of Inventory1, not the Row() from the original Inventory sheet. How can I get Row() to populate for each new row of data added to Inventory1 during this macro?

It's hard to guess where you want the date and where the row(), and which row(), just by looking at some code.
It would be easier if you explained what columns you have in your original data, what columns you have after the filter, in which column you want the date, in which column you want the row() and in that way explain what data you want in each column.


I'll make another try, but I guess with the following you can adapt the code, if you need any changes.

Sub INV_historyfilter()
  Dim lr As Long, lastROW As Long, lr2 As Long, n As Long
    
  advINVHISTfilterCLEAR 'clears adv filter criteria and extract ranges
  With Inventory 'sheet1
    lastROW = .Range("A" & Rows.Count).End(xlUp).Row 'last item row
    If lastROW < 3 Then Exit Sub
    
    .Range("A2:Q" & lastROW).AdvancedFilter xlFilterCopy, .Range("CD1:CD2"), .Range("CF2:CV2"), Unique:=True
    lr = .Range("CF" & Rows.Count).End(xlUp).Row
    If lr < 3 Then Exit Sub
    
    lr2 = Inventory1.Range("A" & Rows.Count).End(3).Row + 1
    n = lr - 2
    Inventory1.Range("A" & lr2).Resize(n, 17).Value = .Range("CF3:CV" & lr).Value
    Inventory1.Range("R" & lr2 & ":R" & lr2 + n - 1).Value = Date
    Inventory1.Range("S" & lr2 & ":S" & lr2 + n - 1).Value = "=Row()"
  End With
End Sub

 

[Lil Stinker]

I thought you wizards had ways of seeing everything! Either way, you nailed it masterfully. Now, I only wish I fully understood your code so I could implement it elsewhere. It's just as fast as the AdvancedFilter!

Thanks again!