Filter and copy Loop fails when using an array

mordrid

Board Regular
Joined
Jul 22, 2005
Messages
219
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

VBA Code:
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
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,502
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...

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

with

Code:
    CopyRng.Copy

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

Hope this helps!
 
Last edited:

mordrid

Board Regular
Joined
Jul 22, 2005
Messages
219
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...

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

with

Code:
    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
1616770066106.png
and the .pastespecial xlpastvalues was highlighted
 

mordrid

Board Regular
Joined
Jul 22, 2005
Messages
219

ADVERTISEMENT

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

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,502
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

Board Regular
Joined
Jul 22, 2005
Messages
219

ADVERTISEMENT

Hi it says Last = 0
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,502
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...

VBA Code:
    CopyRng.Copy

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

    Application.CutCopyMode = xlCopy

Does this help?
 

mordrid

Board Regular
Joined
Jul 22, 2005
Messages
219
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

Board Regular
Joined
Jul 22, 2005
Messages
219
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,751
Messages
5,638,154
Members
417,010
Latest member
jnuss03

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top