Filter messes with VBA

[Rob_010101]

Hello,

I am using the below code, which moves a row to another sheet based upon the value of a drop-down list item.

However, if the data on the sheet the row is moving to is filtered, instead of adding the copied row to the first blank row at the bottom of the data, it overwrites a row of data next in the list. For example, when filtering on Chester, it will overwrite the first row of data where the location is Doncaster, instead of adding the data to the first blank row right at the bottom of the data.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
   
    If Not Application.Intersect(Target, Range("O2:O500000")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
                archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                Range(Cells(fromRow, 1), Cells(fromRow, 15)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

Wondering if someone might know how to get the above to ignore a filter.

Kind Regards
Chris

 

[jasonb75]

It's old but it should still work.

finding Last row ??

Hi All I thought this would be a lounge type question. I have noticed over some time that many users have a different spin on finding the last row. I was wondering which is the fastest, most efficient, etc. I use: Lrow=Cells(Rows.Count,"A").End(xlUp).Row while others use: LR = Range("A" &...

www.mrexcel.com

 

[Rob_010101]

Thanks for your reply.

I've looked through the thread you posted and it looks like this might work but my question is, how would I incorporate that into my VB code?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
   
    If Not Application.Intersect(Target, Range("O2:O500000")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
                archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                Range(Cells(fromRow, 1), Cells(fromRow, 15)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

KR

 

[jasonb75]

See if this does what you need, I haven't been able to test the theory.

You shouldn't need to use + 1 at the end of the filter count, based on the logic of the post that I linked to, you need to subtract 1 to get the actual last row so by not subtracting you would get the first empty row as required.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
   
    If Not Application.Intersect(Target, Range("O2:O500000")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
                
                With archiveList
                    If .FilterMode Then
                        archiveRow = .AutoFilter.Range.Row + .AutoFilter.Range.Rows.Count
                    Else
                        archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                    End If
                End With
                
                Range(Cells(fromRow, 1), Cells(fromRow, 15)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

 

[Rob_010101]

Hi Jason

This kind of works, however, it places the row at 9982 when the last row of data is row 519.

As you can see, "location" is filtered and the new row would be placed at 9983 in this example, however, the last row of data (when filter is not applied) is:

I am very thankful for your help

KR

 

[Alex Blakenburg]

I am guessing that you have 1 or more columns using formulas that return "" when the data rows are empty and this is expanding your autofilter / usedrange beyond what you consider to be your last row.
Try the below. It uses an array version of the match function to work out the last row and match looks in both visible and hidden rows.
Because it is an array formula VBA needs evaluate to actually calculate it.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet

    If Target.Cells.Count > 1 Then Exit Sub
  
    If Not Application.Intersect(Target, Range("O2:O500000")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
               
                With archiveList
                    Dim strMatch As String
                    strMatch = "match" & Replace("(2,1/(a:a>""""))", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
                    archiveRow = Evaluate(strMatch) + 1
                End With
               
                Range(Cells(fromRow, 1), Cells(fromRow, 15)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

 

[Rob_010101]

I am guessing that you have 1 or more columns using formulas that return "" when the data rows are empty and this is expanding your autofilter / usedrange beyond what you consider to be your last row.
Try the below. It uses an array version of the match function to work out the last row and match looks in both visible and hidden rows.
Because it is an array formula VBA needs evaluate to actually calculate it.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet

    If Target.Cells.Count > 1 Then Exit Sub
 
    If Not Application.Intersect(Target, Range("O2:O500000")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
              
                With archiveList
                    Dim strMatch As String
                    strMatch = "match" & Replace("(2,1/(a:a>""""))", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
                    archiveRow = Evaluate(strMatch) + 1
                End With
              
                Range(Cells(fromRow, 1), Cells(fromRow, 15)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

There aren't any formulas in the sheet, however, will give this a go anyway and let you know

KR

 

[Alex Blakenburg]

Actually since it is using Autofilter, I should have retained the FilterMode check.

                With archiveList
                    If .FilterMode Then
                        Dim strMatch As String
                        strMatch = "match" & Replace("(2,1/(a:a>""""),1)", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
                        archiveRow = Evaluate(strMatch) + 1
                    Else
                        archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                    End If
                End With

 

[Alex Blakenburg]

There aren't any formulas in the sheet, however, will give this a go anyway and let you know

Interesting. To get the result your are getting I would expect something to be causing your autofilter range to be including more rows than you are expecting it to include.
With the table unfiltered and a cell in the table selected put in Ctrl+A and see how far down gets selected.

In any event I am hoping that match will pick up the right last row for you. Please copy in my 2nd post over that section in my first post before you try it.

 

[Rob_010101]

Interesting. To get the result your are getting I would expect something to be causing your autofilter range to be including more rows than you are expecting it to include.
With the table unfiltered and a cell in the table selected put in Ctrl+A and see how far down gets selected.

In any event I am hoping that match will pick up the right last row for you. Please copy in my 2nd post over that section in my first post before you try it.

Yes, Ctrl+A goes down to row 9981 and I've just noticed there's a IF(OR(ISBLANK formula in column U, ****! - Perhaps a physical opposed to a visual check is best in future!

I've just tried Jason's VB and it's still adding the row to 998X, so will try yours. Is the below correct?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet

    If Target.Cells.Count > 1 Then Exit Sub
  
    If Not Application.Intersect(Target, Range("M2:M500000")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("USED - Ops RAs")
            If Target.Value = "Filled" Then
                fromRow = ActiveCell.Row
               
                
With archiveList
                    If .FilterMode Then
                        Dim strMatch As String
                        strMatch = "match" & Replace("(2,1/(a:a>""""),1)", "a:a", .AutoFilter.Range.Cells(1).EntireColumn.Address(0, 0, 1, 1))
                        archiveRow = Evaluate(strMatch) + 1
                    Else
                        archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                    End If
                End With
 End Sub