Excel Macro Copying A Single Row It Shouldn't

Question

I have a macro designed to copy a row's contents to a separate sheet based on a value contained in one of several columns with the click of a button, which is contained on the originating sheet:

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim longLastRow As Long
Dim Cancelled As Worksheet, Discontinued As Worksheet, NotConf24 As Worksheet, ESDout As Worksheet, NotConfShip As Worksheet, NotConfShip24 As Worksheet

Set Cancelled = Sheets("Cancelled")
Set Discontinued = Sheets("Discontinued")
Set NotConf24 = Sheets("NotConfAvail24hr")
Set ESDout = Sheets("ESDoutsideLeadtime")
Set NotConfShipLead = Sheets("NotConfButShipInLead")
Set NotConfShip24 = Sheets("NotConfShip24hrs")

longLastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range("A2", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=13, Criteria1:="Yes"
    .Copy Cancelled.Range("A1")
    .AutoFilter Field:=14, Criteria1:="Yes"
    .Copy Discontinued.Range("A1")
    .AutoFilter Field:=15, Criteria1:="No"
    .Copy NotConf24.Range("A1")
    .AutoFilter Field:=16, Criteria1:="Yes"
    .Copy NotConfShipLead.Range("A1")
    .AutoFilter Field:=18, Criteria1:="No"
    .Copy NotConfShip24.Range("A1")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

The problem I'm having is it's copying the first row in the range, A2, to every sheet even if it doesn't meet the criteria. I have very little experience working with VBA. I got this macro from here and have perused a significant number of other articles pertaining to this type of function, have tried many of the solutions offered, and have come up short each time.

In the post I linked above, one user had a similar problem (it ONLY copied the first row in the range), and it was suggested that it could be due to the fact that column A might not contain a value on the actual last row with content; however, in my case it does. All columns between A and T have a value.

Other than that, this macro works great! Able to sort ~10,000 rows in less than a second.

Not sure if it's related to your issue, but FYI `longLastRow = Cells(Rows.Count, "A").End(xlUp).Row` is getting the last row on whatever sheet is your active sheet. I'd qualify that with a sheet name if you want to get a single LastRow, or add it in a loop if you need each sheet to have different last rows. (IE `Cancelled.Cells(Cancelled.Rows.Count,"A").End(xlUp).Row`. And your copying info is starting at `A2`, because that's where you told it (`With Range("A2", ...)`). — BruceWayne, Jan 28 '16 at 00:49
In this case, this isn't an issue. The macro is run by clicking a button on the worksheet that all of the data is coming from. However, I will absolutely keep that in mind for future endeavors. As for the copy issue, it shouldn't just outright copy `A2` unless it meets the criteria should it? The reason I start with `A2` is because the columns have headers. — HindenPeter, Jan 28 '16 at 00:59
If I'm reading it correctly, I think the issue i that you don't change the range that's being copied. Let's just say your `longLastRow = 10`. Your `Range("A2","T10")` doesn't change before you do `.copy`. Thus, it's always going to copy with that range. I am not too up to speed on Filters, but I'll take a look. You really just need to adjust the Copy Range... — BruceWayne, Jan 28 '16 at 01:02

Dirk Reichel · Answer 1 · 2016-01-28T02:06:15.317

Pls try this:

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim longLastRow As Long
Dim Cancelled As Worksheet, Discontinued As Worksheet, NotConf24 As Worksheet, ESDout As Worksheet, NotConfShip As Worksheet, NotConfShip24 As Worksheet

Set Cancelled = Sheets("Cancelled")
Set Discontinued = Sheets("Discontinued")
Set NotConf24 = Sheets("NotConfAvail24hr")
Set ESDout = Sheets("ESDoutsideLeadtime")
Set NotConfShipLead = Sheets("NotConfButShipInLead")
Set NotConfShip24 = Sheets("NotConfShip24hrs")

longLastRow = Cells(Rows.Count, "A").End(xlUp).Row

Dim cpyRng As Range
Set cpyRng = Range("A3", "T" & longLastRow)

With Range("A2", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=13, Criteria1:="Yes"
    cpyRng.Copy Cancelled.Range("A1")
    .AutoFilter Field:=14, Criteria1:="Yes"
    cpyRng.Copy Discontinued.Range("A1")
    .AutoFilter Field:=15, Criteria1:="No"
    cpyRng.Copy NotConf24.Range("A1")
    .AutoFilter Field:=16, Criteria1:="Yes"
    cpyRng.Copy NotConfShipLead.Range("A1")
    .AutoFilter Field:=18, Criteria1:="No"
    cpyRng.Copy NotConfShip24.Range("A1")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

You also could change the cpyRng. to .Offset(1).Resize(.Rows.Count - 1). and skip out the whole cpyRng-Variable this way...

Still, I'm sure that this should be a easy fast solution :)

Hi Dirk, thanks for the suggestion! I finally had time to give this a try today (this a backburner project at work), and unfortunately I'm still having the same issue with the first line in the range being copied. I also noticed that the column header filters are being stripped, which may have been a problem that I hadn't noticed before. I'm not really sure what to do here. I've asked for additional help internally, but was told that I'll have to go it alone, and this is really my first foray into VBA. — HindenPeter, Feb 04 '16 at 17:27

score 0 · Accepted Answer · answered Feb 05 '16 at 19:45

So I used suggestions from BruceWayne and a hint here regarding enabling auto filter to come up with a solution that ended up working really well. After speaking with my boss, it was determined that we want the header row to always be copied, which is why you'll see the range has changed.

Here's what I came up with:

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim longLastRow As Long
Dim AllData As Worksheet, Cancelled As Worksheet, Discontinued As Worksheet, NotConf24 As Worksheet, ESDout As Worksheet, NotConfShip As Worksheet, NotConfShip24 As Worksheet, NoTrack As Worksheet

Set Cancelled = Sheets("Cancelled")
Set Disco = Sheets("Discontinued")
Set NotConf24 = Sheets("NotConfAvail24hr")
Set ESDout = Sheets("ESDoutsideLeadtime")
Set NotConfShipLead = Sheets("NotConfButShipInLead")
Set NotConfShip24 = Sheets("NotConfShip24hrs")
Set AllData = Sheets("All Data")
Set NoTrack = Sheets("NoTracking")

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=13, Criteria1:="Yes"
    .Copy Cancelled.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=14, Criteria1:="Yes"
    .Copy Disco.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=15, Criteria1:="No"
    .Copy NotConf24.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=16, Criteria1:="Yes"
    .Copy NotConfShipLead.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=17, Criteria1:="No"
    .Copy ESDout.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=18, Criteria1:="No"
    .Copy NotConfShip24.Range("A1")
    .AutoFilter
End With

longLastRow = AllData.Cells(AllData.Rows.Count, "A").End(xlUp).Row

With Range("A1", "T" & longLastRow)
    .AutoFilter
    .AutoFilter Field:=19, Criteria1:="No"
    .Copy NoTrack.Range("A1")
    .AutoFilter
End With

If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A1").AutoFilter
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

This copies the correct rows properly, including the header row, and ensures that the filters aren't stripped from the header row in AllData.

Repeating longLastRow and separating the .AutoFilter and .Copy functions into individual blocks may not be necessary, but it works, and I don't want to mess with it for fear of breaking it again.

Thanks to everyone for their help and suggestions!

Excel Macro Copying A Single Row It Shouldn't

2 Answers2