Macro not finding filtered value, copying whole data unfiltered. How to prevent this?

jalrs

jalrs

Active Member
Joined
Apr 6, 2022
Messages
300
Office Version
  1. 365
Platform
  1. Windows
Good morning guys,

If my macro doesn't find the filtered value, it is copying all the data which is wrong. How to prevent this? It should either just resume next i value for next filter value or just delete the template lines, leaving row 1 with the headers.

My loop code is as follows:

VBA Code: 
For i = 2 To lr2
        
        valorfiltro = Cells(i, 1).Value
        
        Workbooks.Open Filename:=ThisWorkbook.Path & "\Controlo e Difusão\Templates\ST_TEMPLATE_" & Cells(i, 1).Value & ".xlsx"
        
        Set wb2 = Workbooks("ST_TEMPLATE_" & valorfiltro & ".xlsx")
        
        Set ws3 = wb2.Worksheets("Pendentes")
        
        ws3.Activate
        
        lr3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row + 1
        
        ws1.Activate
        
        With ws1.Range("A5:AV" & lr1)
        
            .AutoFilter 46, valorfiltro
            .AutoFilter 47, "Em tratamento"
            
            With ws1
            
                .Range("A6:AV" & lr1).Copy
                ws3.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
                
                .Range("BH6:BH" & lr1).Copy
                ws3.Cells(2, 49).PasteSpecial Paste:=xlPasteValues
            
            End With
            
            Application.CutCopyMode = False
            
            .AutoFilter
        
        End With
        
        lr3 = ws3.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
        ws3.Range("A" & lr3 & ":A1001").EntireRow.Delete
        
        wb2.Activate ' don't think this part of the loop matters
        
        ws3.Activate 'same as above
        
        wb2.RefreshAll 'same as above
        
        Range("A2").Select 'same as above
        
        ws3.Protect Password:="blabla", _ 'same as above
        DrawingObjects:=False, _ 'same as above
        Contents:=True, _ 'same as above
        Scenarios:=False, _ 'same as above
        UserInterfaceOnly:=True, _ 'same as above
        AllowFormattingCells:=True, _ 'same as above
        AllowFormattingColumns:=True, _ 'same as above
        AllowFormattingRows:=True, _ 'same as above
        AllowInsertingColumns:=False, _ 'same as above
        AllowInsertingRows:=False, _ 'same as above
        AllowInsertingHyperlinks:=False, _ 'same as above
        AllowDeletingColumns:=False, _ 'same as above
        AllowDeletingRows:=False, _ 'same as above
        AllowSorting:=True, _ 'same as above
        AllowFiltering:=True, _ 'same as above
        AllowUsingPivotTables:=False 'same as above

        mypath = ThisWorkbook.Path & "\Controlo e Difusão\Partilhas e Regularizações\" 'same as above
            
        wb1.Activate 'same as above
        
        ws2.Activate 'same as above
        
        docname = Cells(i, 5).Value 'same as above
        
        wb2.Activate 'same as above
        
        ws3.Activate 'same as above
        
        ActiveWorkbook.SaveAs Filename:=mypath & docname & ".xlsx", FileFormat:=xlOpenXMLWorkbook 'same as above
    
        ActiveWorkbook.Close 'until here 'same as above
        
    Next i

Any help is greatly appreciated.

Thanks!
 
Sort by date Sort by votes
My failure...

I forgot to restate that .SpecialCells(xlCellTypeVisible) has to be used in your Copy commands; such as
VBA Code: 
                    With ws1                              'Your block
                        .Range("G6:AM" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
'etc etc
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Anthony47 said:
My failure...

I forgot to restate that .SpecialCells(xlCellTypeVisible) has to be used in your Copy commands; such as
VBA Code: 
                    With ws1                              'Your block
                        .Range("G6:AM" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
'etc etc
Click to expand...
Hi Anthony,

Error "No cells were found" shows up.

Thoughts?

Thanks!
 
Upvote 0
We used:
VBA Code: 
                On Error Resume Next
                Set rng1 = ws1.Range("A5:AV" & lr1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
I don't know how your data are organized, but in case Row 5 contains headers then we have to use ws1.Range("A6:AV" & lr1).SpecialCells(xlCellTypeVisible)
 
Upvote 0
Anthony47 said:
We used:
VBA Code: 
                On Error Resume Next
                Set rng1 = ws1.Range("A5:AV" & lr1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
I don't know how your data are organized, but in case Row 5 contains headers then we have to use ws1.Range("A6:AV" & lr1).SpecialCells(xlCellTypeVisible)
Click to expand...
Hey Anthony.

Looks like we on to something. It still displayed "no cells were found" error. But it worked for the first 2 values.
First value that he reads on the loop doesn't have data, second value has data, third doesn't have data. (at the moment)

Did it breake because the previous value had data and he's expecting the no data values first?

Thanks Anthony, one step closer!
 
Upvote 0
If you work in a loop then we need this additional instruction:
VBA Code: 
                On Error Resume Next
                Set rng1 = Nothing         '<<<< THIS
                Set rng1 = ws1.Range("A5:AV" & lr1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0

AV5 or AV6? You know
 
Upvote 0
Anthony47 said:
If you work in a loop then we need this additional instruction:
VBA Code: 
                On Error Resume Next
                Set rng1 = Nothing         '<<<< THIS
                Set rng1 = ws1.Range("A5:AV" & lr1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
Click to expand...
Hey Anthony.

Working as intended, could you describe what it does, so I can explain that bit of code as well and as intended to my teacher when delivering the written report?

Additionally, could you, when doing so, if doing so, and if not too, copy this code, so I can mark your post as the solution, instead of being me to post the actual working code? Credits where credits are due! And they belong to you and not to me.

VBA Code: 
With ws1.Range("A5:AV" & lr1)

                .AutoFilter 47, valorfiltro

                On Error Resume Next
        
                set rng1 = nothing

                Set rng1 = ws1.Range("A6:AV" & lr1).SpecialCells(xlCellTypeVisible)

                On Error GoTo 0

                If Not rng1 Is Nothing Then   
                            
                    With ws1
                                                              
                        .Range("G6:AM" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
                
                        .Range("AU6:AU" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 34).PasteSpecial Paste:=xlPasteValues
                        
                        .Range("BH6:BH" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 35).PasteSpecial Paste:=xlPasteValues
                
                        .Range("BN6:BN" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 36).PasteSpecial Paste:=xlPasteValues

                    End With

                End If
                
                Application.CutCopyMode = False

                .AutoFilter

End with

Thanks Anthony!
 
Upvote 0
So this is the working code, with some "key" comments:
VBA Code: 
Dim Rng1 As Range       'Dim is necessary, or Rng1 could be Empty, or Nothing, or a valid range
'
'
'
'
With ws1.Range("A5:AV" & lr1)
                .AutoFilter 47, valorfiltro
'This block checks the filtered data contains some visible rows:
                On Error Resume Next                'don't rise any Error
                    Set Rng1 = Nothing              'preset value
                    Set Rng1 = ws1.Range("A6:AV" & lr1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
'Now rng1 is either Nothing (no data) or a valid Range (some data)
'End block
'
                If Not Rng1 Is Nothing Then             'Copy (visible cells) only if there are rows to copy
                    With ws1
                        .Range("G6:AM" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
                
                        .Range("AU6:AU" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 34).PasteSpecial Paste:=xlPasteValues
                        
                        .Range("BH6:BH" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 35).PasteSpecial Paste:=xlPasteValues
                
                        .Range("BN6:BN" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 36).PasteSpecial Paste:=xlPasteValues
                    End With
                End If
                Application.CutCopyMode = False
                .AutoFilter
End With
 
Upvote 0
Solution
Anthony47 said:
So this is the working code, with some "key" comments:
VBA Code: 
Dim Rng1 As Range       'Dim is necessary, or Rng1 could be Empty, or Nothing, or a valid range
'
'
'
'
With ws1.Range("A5:AV" & lr1)
                .AutoFilter 47, valorfiltro
'This block checks the filtered data contains some visible rows:
                On Error Resume Next                'don't rise any Error
                    Set Rng1 = Nothing              'preset value
                    Set Rng1 = ws1.Range("A6:AV" & lr1).SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
'Now rng1 is either Nothing (no data) or a valid Range (some data)
'End block
'
                If Not Rng1 Is Nothing Then             'Copy (visible cells) only if there are rows to copy
                    With ws1
                        .Range("G6:AM" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
               
                        .Range("AU6:AU" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 34).PasteSpecial Paste:=xlPasteValues
                       
                        .Range("BH6:BH" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 35).PasteSpecial Paste:=xlPasteValues
               
                        .Range("BN6:BN" & lr1).SpecialCells(xlCellTypeVisible).Copy
                        ws3.Cells(2, 36).PasteSpecial Paste:=xlPasteValues
                    End With
                End If
                Application.CutCopyMode = False
                .AutoFilter
End With
Click to expand...
Pleasure to learn from you Anthony, see you around! Marked as solution.

Thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
679
mumps
mumps
jalrs
  • Solved
Copying values and not formulas
Replies
8
Views
595
rollis13
rollis13
jalrs
  • Solved
Loop Working but gives me a run Time Error 1004
2
Replies
10
Views
2K
jalrs
jalrs
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
507
sspatriots
S
jalrs
  • Solved
PivotTable not Refreshing
2 3 4
Replies
36
Views
2K
Alex Blakenburg
A

Forum statistics

Threads
1,224,823
Messages
6,181,169
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top