Filter and copy Loop fails when using an array

[mordrid]

Hi I have been working on the following code, basically it should filter against two columns across multiple worksheets and dump the results into anther worksheet. The issue that I have is it only appears to post a single row off the final sheet in the Array and I can not understand what is wrong. Any help would be appreciated

Sub OverdueUpdate()

Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range
    Dim lr As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Clears exiting content
    Worksheets("Overdue Items").Range("B8:F29").ClearContents

    Set DestSh = ActiveWorkbook.Worksheets("Overdue Items")

    'Looks through the sheets named and copies data to overdue
  For Each sh In ActiveWorkbook.Sheets(Array("Due Diligence", "Pre-Filing", "Product Development", "CAPM", "Operations"))
               
            'Find the last rows with data
            Last = LastRow(DestSh)
            Last2 = LastRow(sh)
           
            'Filter
            With sh.Range("B5:F" & Last2)
            .AutoFilter Field:=1, Criteria1:="<100%"
            .AutoFilter Field:=3, Criteria1:="<FilterToday"
           
            End With

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("B5:F" & Last2 & lr).SpecialCells(xlCellTypeVisible)
           
            With sh.Range("B5:F" & Last2)
            .AutoFilter Field:=1
            .AutoFilter Field:=3
            End With
           
              With CopyRng
                 DestSh.Cells(Last + 1, "B").Resize(.Rows.Count, _
                .Columns.Count).Value = .Value
             End With
            
    Next

End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("b8"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

 

[Domenic]

In taking a quick look, it looks like the problem lies where you try to transfer the values to your destination worksheet. You can't use .value = .value when the range contains hidden rows. Try replacing...

              With CopyRng
                 DestSh.Cells(Last + 1, "B").Resize(.Rows.Count, _
                .Columns.Count).Value = .Value
             End With

with

    CopyRng.Copy

    With DestSh
        .Activate
        With .Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            .Select
        End With
    End With
  
    Application.CutCopyMode = xlCopy

Hope this helps!

 

[mordrid]

In taking a quick look, it looks like the problem lies where you try to transfer the values to your destination worksheet. You can't use .value = .value when the range contains hidden rows. Try replacing...

              With CopyRng
                 DestSh.Cells(Last + 1, "B").Resize(.Rows.Count, _
                .Columns.Count).Value = .Value
             End With

with

    With DestSh
        .Activate
        With .Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            .Select
        End With
    End With
   
    Application.CutCopyMode = xlCopy

Hope this helps!

Hi Domenic, thanks for coming back so quickly however when I replaced the code as advised I got the following message

and the .pastespecial xlpastvalues was highlighted

 

[Domenic]

Can you post your amended code?

 

[mordrid]

Hi this is what I did, I basically commented out the code I had and put yours in, once I have it working I planned to clean out the other code completely

' With CopyRng
' DestSh.Cells(Last + 1, "B").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
' End With

With DestSh
.Activate
With .Cells(Last + 1, "B")
.PasteSpecial xlPasteValues
.Select
End With
'End With

Application.CutCopyMode = xlCopy
End With

 

[Domenic]

First, add a breakpoint at the line With .Cells(Last + 1, "B"), then run the code again until it stops at that line. Then, move your cursor over the variable Last. What value has it been assigned?

 

[mordrid]

Hi it says Last = 0

 

[Domenic]

Actually, I see that I forgot to include a line which actually copies the range before pasting it. I have edited my post. So it should now be as follows...

    CopyRng.Copy

    With DestSh
        .Activate
        With .Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            .Select
        End With
    End With

    Application.CutCopyMode = xlCopy

Does this help?

 

[mordrid]

Hi, thanks for that, however although it now copies and pasts all the filtered data rather than just a row, it is still only copying and pasting the data off the last sheet in the array onto the Overdue sheet.

 

[mordrid]

Hi, I am also not convinced that the following filter lines are working, can you confirm that would be the correct way of filtering if I want items earlier than todays date that are less than 100% complete. I am sure the less that 100% works its the date filter I question

With sh.Range("B5:F" & Last2)
.AutoFilter Field:=1, Criteria1:="<100%"
.AutoFilter Field:=3, Criteria1:="<FilterToday"

End With