VBA, Advanced Filter

wonka1234 · Aug 15th 2015

Hi Guys, I got the following code that does an advanced filter. I had the first filtering of a column working but now when I combine 2 filters I get issues.

Code

Dim wks As Excel.WorksheetDim wksSummary As Excel.Worksheet
'----------------------------------------------------------------------------------
'edited so it shows in the 3rd column row +1.  Add the header and sheet name macro to this
'via david G
'has to have a column header to work. (aug 12)
 
 
On Error Resume Next
Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0
 
If wksSummary Is Nothing Then
    Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
    wksSummary.Name = "Unique data"
End If
 
 
'Iterate through all the worksheets, but skip [Summary] worksheet.
For Each wks In Excel.ActiveWorkbook.Worksheets
 
    With wksSummary
 
'change the range values for which column u want to get advanced filter
        If wks.Name <> .Name Then
            If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
                Dim r As Range
                
               With wksSummary
               
               If wks.Name <> .Name Then
        If Application.WorksheetFunction.CountA(wks.Range("a:a")) Then
             Dim y As Range
     ' Get the first cell of our destination range... Change both col #'s to change col location
       Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
       Set y = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 5)
 
     ' Perform the unique copy...
     If WorksheetFunction.CountA(wks.Range("f:f")) > 1 Then
       If WorksheetFunction.CountA(wks.Range("a:a")) > 1 Then
       wks.Range("f:f").AdvancedFilter xlFilterCopy, , r, True
       wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True
       
     Else
       r = "N/A"
       y = "N/A"
     End If
 
    ' Remove the first cell at the destination range... Test without this next line r.Delete xlShiftUp, remove it and get N/A.s
 
 
 
            End If
 
       r.Delete xlShiftUp
 
    End If
 
    
 
     Next wks

Display More

I get errors on the End Ifs and The Nexts, is my formatting off?

**mikerickson** · Aug 15th 2015

Re: VBA, Advanced Filter

You are missing one End If.

I can't see a close to

Code

If ws.Name <> Name Then

**Batman** · Aug 15th 2015

Re: VBA, Advanced Filter

If your code is properly indented, as most of it seems to be, you should be able to follow the code downwards in a straight line to see whether the start of a code block (With / For / If) is properly ended.

As mikerickson says, you appear to be missing an End If, but then we can't see all of your code to say what else might be causing a problem. There look to be other block endings missing as well.

By the way, declaring variables inside a block of code does not have any effect on whether or not they are declared. The compiler will declare them before running your program, so you might as well declare them at the start of the procedure or code module, whichever is relevant.

wonka1234 · Aug 15th 2015

Re: VBA, Advanced Filter

Quote from mikerickson;754351
You are missing one End If.

I can't see a close to
Code
If ws.Name <> Name Then

Code

If wks.Name <> .Name Then            If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
                Dim r As Range
                End If

Added it there. Get a Next Wks error now. sigh

wonka1234 · Aug 15th 2015

Re: VBA, Advanced Filter

Quote from Batman;754353

If your code is properly indented, as most of it seems to be, you should be able to follow the code downwards in a straight line to see whether the start of a code block (With / For / If) is properly ended.

As mikerickson says, you appear to be missing an End If, but then we can't see all of your code to say what else might be causing a problem. There look to be other block endings missing as well.

By the way, declaring variables inside a block of code does not have any effect on whether or not they are declared. The compiler will declare them before running your program, so you might as well declare them at the start of the procedure or code module, whichever is relevant.

Thanks for the tips, Im going to post my full code :

Code

Sub AlwaysTesty() 
 
'Added insert to col F, and added through each worksheet, works perfect
'Add header so louis6 will work. Added. 100% working
'Next is to loop through Directory.
 
 
 
 'TestingSecondAdvancedFilter
 
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
 
 
 'took out insert header here




 
'change these values
 
 
lr = Cells(Rows.Count, "c").End(3).Row
Set myrg = Range("f2:f" & lr)
myrg.ClearContents
myrg.Formula = "=IFERROR(LEFT(e2,FIND(""_"",e2,1)-1),LEFT(e2,2))"
myrg.Value = myrg.Value
 
'Header so louis6 will work
Range("f1").Value = "Test"
 
Next ws
 
 
 
Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
'----------------------------------------------------------------------------------
'edited so it shows in the 3rd column row +1.  Add the header and sheet name macro to this
'via david G
'has to have a column header to work. (aug 12)
 
 
On Error Resume Next
Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0
 
If wksSummary Is Nothing Then
    Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
    wksSummary.Name = "Unique data"
End If
 
 
'Iterate through all the worksheets, but skip [Summary] worksheet.
For Each wks In Excel.ActiveWorkbook.Worksheets
 
    With wksSummary
 
'change the range values for which column u want to get advanced filter
        If wks.Name <> .Name Then
            If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
                Dim r As Range
                End If
                
               With wksSummary
               
               If wks.Name <> .Name Then
        If Application.WorksheetFunction.CountA(wks.Range("a:a")) Then
             Dim y As Range
     ' Get the first cell of our destination range... Change both col #'s to change col location
       Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
       Set y = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 5)
 
     ' Perform the unique copy...
     If WorksheetFunction.CountA(wks.Range("f:f")) > 1 Then
       If WorksheetFunction.CountA(wks.Range("a:a")) > 1 Then
       wks.Range("f:f").AdvancedFilter xlFilterCopy, , r, True
       wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True
       
     Else
       r = "N/A"
       y = "N/A"
     End If
 
    ' Remove the first cell at the destination range... Test without this next line r.Delete xlShiftUp, remove it and get N/A.s
 
 
 
            End If
 
       r.Delete xlShiftUp
 
    End If
 
    
 
     Next wks
 
     ''''''''''''''''''''''''




 
 
  
           'Headers and sheet names
    Range("A1").Value = "File Name "
     Range("B1").Value = "Sheet Name "
     Range("C1").Value = "Node"
    Range("D1").Value = "Scenario Name"
 
   Dim intRow As Long: intRow = 2
 
    For i = 1 To Sheets.Count
If Sheets(i).Name <> ActiveSheet.Name Then
    Cells(intRow, 2) = Sheets(i).Name
    Cells(intRow, 1) = ActiveWorkbook.Name
    intRow = intRow + 1
End If
    Next i
 




 
End Sub

Display More

**Batman** · Aug 16th 2015

Re: VBA, Advanced Filter

I have removed most of the comment and blank rows, to make the code (for this purpose only) easier to follow:

Code

Sub AlwaysTesty()
    Dim ws As Worksheet
    Dim wks As Excel.Worksheet
    Dim wksSummary As Excel.Worksheet
    Dim y As Range
    Dim intRow As Long
    Dim r As Range
    
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
         
        lr = Cells(Rows.Count, "c").End(3).Row
        Set myrg = Range("f2:f" & lr)
        myrg.ClearContents
        myrg.Formula = "=IFERROR(LEFT(e2,FIND(""_"",e2,1)-1),LEFT(e2,2))"
        myrg.Value = myrg.Value
         
        Range("f1").Value = "Test"
    Next ws
     
    On Error Resume Next
    Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
    On Error GoTo 0
     
    If wksSummary Is Nothing Then
        Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
        wksSummary.Name = "Unique data"
    End If
    For Each wks In Excel.ActiveWorkbook.Worksheets
        With wksSummary
            If wks.Name <> .Name Then
'                THIS SECTION OF CODE IS POINTLESS. 'r' WILL ALWAYS BE DECLARED IRRESPECTIVE OF THE 'IF' STATEMENT
'                If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
'                    Dim r As Range
'                End If
                 
                With wksSummary
                    If wks.Name <> .Name Then
                        If Application.WorksheetFunction.CountA(wks.Range("a:a")) Then
                            Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
                            Set y = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 5)
                             
                            If WorksheetFunction.CountA(wks.Range("f:f")) > 1 Then
                                If WorksheetFunction.CountA(wks.Range("a:a")) > 1 Then
                                    wks.Range("f:f").AdvancedFilter xlFilterCopy, , r, True
                                    wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True
                                Else
                                    r = "N/A"
                                    y = "N/A"
                                End If
                            End If
                             
                            r.Delete xlShiftUp
                        End If
                    Next wks
                    
                    Range("A1").Value = "File Name "
                    Range("B1").Value = "Sheet Name "
                    Range("C1").Value = "Node"
                    Range("D1").Value = "Scenario Name"
                     
                    intRow = 2
                    For i = 1 To Sheets.Count
                        If Sheets(i).Name <> ActiveSheet.Name Then
                            Cells(intRow, 2) = Sheets(i).Name
                            Cells(intRow, 1) = ActiveWorkbook.Name
                            intRow = intRow + 1
                        End If
                    Next i
                End Sub

Display More

If you follow the code block starters (Sub / If / For / With) downwards in a straight line, you should be able to see that they end with their respective block enders (End Sub / End If / Next / End With). If not, then you have either not indented properly (which seems not to be the case), or you have missed out some of the block endings.

The fact that your End Sub statement is indented by 4 'tabs' suggests that you have missed out 4 block endings. These appear to be End If (x2) and End With (x2).

I have deliberately not simply corrected the code for you as, if you are using these code blocks then you need to understand how to properly end them. Your problems start a couple of lines down from

Code

r.Delete xlShiftUp

when the If block appears to end with 'Next wks'.

Personally, when using these code block statements, as soon as I create the code block start line, I then immediately create the block ending line and insert and indent code between them. That avoids this sort of problem, and helps with you being able to follow the logic of the program while you are developing it.

wonka1234 · Aug 16th 2015

Re: VBA, Advanced Filter

Thanks alot, im still abit confused. So each If/For/With must have an ending no matter how much if's in a row there are?
I added a End With after the 'Next wks' but seem to be stuck on where to find the other If's and With.

**Batman** · Aug 16th 2015

Re: VBA, Advanced Filter

Hi,

Yes, there must be an End If for every If, etc., otherwise VBA doesn't know where to end the code affected by the If.

In order to be able to properly follow the logic of the program, you need to have the End If directly in line with the If that it is ending. I have edited your code to add the missing 4 code block endings; I haven't attempted to try to understand the logic of your program to know whether the endings are located at the correct points in the program.

I have also added a few variable declarations that were missing.

Code

Sub AlwaysTesty()
    Dim ws As Worksheet
    Dim wks As Excel.Worksheet
    Dim wksSummary As Excel.Worksheet
    Dim y As Range
    Dim intRow As Long, i As Integer
    Dim r As Range, lr As Long, myrg As Range
     
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
         
        lr = Cells(Rows.Count, "c").End(3).Row
        Set myrg = Range("f2:f" & lr)
        myrg.ClearContents
        myrg.Formula = "=IFERROR(LEFT(e2,FIND(""_"",e2,1)-1),LEFT(e2,2))"
        myrg.Value = myrg.Value
         
        Range("f1").Value = "Test"
    Next ws
     
    On Error Resume Next
    Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
    On Error GoTo 0
     
    If wksSummary Is Nothing Then
        Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
        wksSummary.Name = "Unique data"
    End If
    For Each wks In Excel.ActiveWorkbook.Worksheets
        With wksSummary
            If wks.Name <> .Name Then
                 '                THIS SECTION OF CODE IS POINTLESS. 'r' WILL ALWAYS BE DECLARED IRRESPECTIVE OF THE 'IF' STATEMENT
                 '                If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
                 '                    Dim r As Range
                 '                End If
                 
                With wksSummary
                    If wks.Name <> .Name Then
                        If Application.WorksheetFunction.CountA(wks.Range("a:a")) Then
                            Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
                            Set y = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 5)
                             
                            If WorksheetFunction.CountA(wks.Range("f:f")) > 1 Then
                                If WorksheetFunction.CountA(wks.Range("a:a")) > 1 Then
                                    wks.Range("f:f").AdvancedFilter xlFilterCopy, , r, True
                                    wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True
                                Else
                                    r = "N/A"
                                    y = "N/A"
                                End If
                            End If
                             
                            r.Delete xlShiftUp
                        End If
                        
                        ' I HAVE INSERTED BLOCK ENDINGS FROM HERE, AND CHANGED THE INDENTING OF THE SUBSEQUENT CODE TO FIT
                        ' The next 4 lines are all inserted
                    End If
                End With
            End If
        End With
                        
    ' I have removed 4 x 'tab' indents from all of the code below
    Next wks
     
    Range("A1").Value = "File Name "
    Range("B1").Value = "Sheet Name "
    Range("C1").Value = "Node"
    Range("D1").Value = "Scenario Name"
     
    intRow = 2
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> ActiveSheet.Name Then
            Cells(intRow, 2) = Sheets(i).Name
            Cells(intRow, 1) = ActiveWorkbook.Name
            intRow = intRow + 1
        End If
    Next i
End Sub

Display More

wonka1234 · Aug 16th 2015

Re: VBA, Advanced Filter

thanks, im starting to understand the code blocks now.
aw man, now im getting an error here

Code

wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True

Do you know why this could be? Like I can do it fine when just filtering f, and still some results show when doing this way. ugh

**Batman** · Aug 16th 2015

Re: VBA, Advanced Filter

Using similar code works fine for me on the test data I have created.

Could you be a bit clearer about the error message you see or, if the code doesn't actually error, what the problem is with the results you are seeing. I'm not sure what you mean by

Quote

Like I can do it fine when just filtering f, and still some results show when doing this way.

It would help if you were to upload a sample workbook that produces the incorrect results.

wonka1234 · Aug 16th 2015

Re: VBA, Advanced Filter

Quote from Batman;754399

Using similar code works fine for me on the test data I have created.

Could you be a bit clearer about the error message you see or, if the code doesn't actually error, what the problem is with the results you are seeing. I'm not sure what you mean by

It would help if you were to upload a sample workbook that produces the incorrect results.

Okay here is the error message and a sample workbook. 3 sheets,. Supposed to advanced filter 2 columns per sheet and put to new sheet. Purpose is to find the unique values in the columns and put them into a format that I can make a pivot table with.

[Blocked Image: http://i.imgur.com/d9g2RVy.jpg]

**Batman** · Aug 16th 2015

Re: VBA, Advanced Filter

The problem is that the code is setting the start cell 'y' to be in the same row as 'r'.

Code

Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
                    Set y = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 5)

As the program is copying different numbers of cells into the two destination columns, after the first loop, 'y' is starting in the middle of the existing list. Assuming that you meant to find a separate next row for 'y', change to

Code

Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
                    Set y = .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 1, 5)

wonka1234 · Aug 16th 2015

Re: VBA, Advanced Filter

Wow thanks a bunch lol. Very simple mistake.
Anyway to populate these results without their headers?

**Batman** · Aug 18th 2015

Re: VBA, Advanced Filter

Hi,

Using Advanced Filter to copy to a new location will always copy the header. You could try (still advanced) filtering in place then, starting at the cell below the header, copy visible cells to the new location. You would then need to remove the filtering.

wonka1234 · Aug 18th 2015

Re: VBA, Advanced Filter

Quote from Batman;754485

Hi,

Using Advanced Filter to copy to a new location will always copy the header. You could try (still advanced) filtering in place then, starting at the cell below the header, copy visible cells to the new location. You would then need to remove the filtering.

thanks, btw what did you mean by:

Code

'                THIS SECTION OF CODE IS POINTLESS. 'r' WILL ALWAYS BE DECLARED IRRESPECTIVE OF THE 'IF' STATEMENT                 '                If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
                 '                    Dim r As Range
                 '                End If

Should I be removing part of my code?

**cytop** · Aug 18th 2015

Re: VBA, Advanced Filter

You can't declare a variable inside an if block. Well, you can but the compiler will ignore the If...

It seems Batman moved the declaration to the top of the procedure where, by convention, it should be in any case.

wonka1234 · Aug 18th 2015

Re: VBA, Advanced Filter

Batman, sometimes when running the macro I get the following: Run-time error '1004' : The extract has a missing or illegal field name .

Code

wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True

I think it might have to do with going through the worksheets, as the most unique values are same through the sheets, testing and putting a different one in sheet 3 makes a difference

**Batman** · Aug 18th 2015

Re: VBA, Advanced Filter

Could you upload a sample workbook containing your latest version of the program and data that causes your program to error?

wonka1234 · Aug 18th 2015

Re: VBA, Advanced Filter

Quote from Batman;754558

Could you upload a sample workbook containing your latest version of the program and data that causes your program to error?

Here is the latest code, believe it is the same thing you uploaded maybe a minor adjustment of where the data populates.

Code

Sub AlwaysTestyv1()'Working Macro Lastest Version.
    Dim ws As Worksheet
    Dim wks As Excel.Worksheet
    Dim wksSummary As Excel.Worksheet
    Dim y As Range
    Dim intRow As Long, i As Integer
    Dim r As Range, lr As Long, myrg As Range
     
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
         
        lr = Cells(Rows.Count, "c").End(3).Row
        Set myrg = Range("f2:f" & lr)
        myrg.ClearContents
        myrg.Formula = "=IFERROR(LEFT(e2,FIND(""_"",e2,1)-1),LEFT(e2,2))"
        myrg.Value = myrg.Value
         
        Range("f1").Value = "Test"
    Next ws
     
    On Error Resume Next
    Set wksSummary = Excel.ActiveWorkbook.Worksheets("Unique data")
    On Error GoTo 0
     
    If wksSummary Is Nothing Then
        Set wksSummary = Excel.ActiveWorkbook.Worksheets.Add
        wksSummary.Name = "Unique data"
    End If
    For Each wks In Excel.ActiveWorkbook.Worksheets
        With wksSummary
            If wks.Name <> .Name Then
                 '                THIS SECTION OF CODE IS POINTLESS. 'r' WILL ALWAYS BE DECLARED IRRESPECTIVE OF THE 'IF' STATEMENT
                 '                If Application.WorksheetFunction.CountA(wks.Range("f:f")) Then
                 '                    Dim r As Range
                 '                End If
                 
                With wksSummary
                    If wks.Name <> .Name Then
                        If Application.WorksheetFunction.CountA(wks.Range("a:a")) Then
                            Set r = .Cells(.Cells(.Rows.Count, 4).End(xlUp).Row + 1, 4)
                            Set y = .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 0, 5)
                             
                            If WorksheetFunction.CountA(wks.Range("f:f")) > 1 Then
                                If WorksheetFunction.CountA(wks.Range("a:a")) > 1 Then
                                    wks.Range("f:f").AdvancedFilter xlFilterCopy, , r, True
                                    wks.Range("a:a").AdvancedFilter xlFilterCopy, , y, True
                                Else
                                    r = "N/A"
                                    y = "N/A"
                                End If
                            End If
                             
                            r.Delete xlShiftUp
                        End If
                         
                         ' I HAVE INSERTED BLOCK ENDINGS FROM HERE, AND CHANGED THE INDENTING OF THE SUBSEQUENT CODE TO FIT
                         ' The next 4 lines are all inserted
                    End If
                End With
            End If
        End With
         
         ' I have removed 4 x 'tab' indents from all of the code below
    Next wks
     
    Range("A1").Value = "File Name "
    Range("B1").Value = "Sheet Name "
    Range("D1").Value = "Scenario Name"
     
    intRow = 2
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> ActiveSheet.Name Then
            Cells(intRow, 2) = Sheets(i).Name
            Cells(intRow, 1) = ActiveWorkbook.Name
            intRow = intRow + 1
        End If
    Next i
End Sub

Display More

**Batman** · Aug 18th 2015

Re: VBA, Advanced Filter

The macro isn't in the workbook you attached, but it refers to the ActiveWorkbook. Is the macro in a different workbook, but you then activate the workbook you want to work on, and manually run the macro?

I must admit to being a little lost as to what data you are trying to work on now. The first loop goes through each sheet, tests for the number of rows used in column C (where there is no data), then puts a formula in column F (where there is already data) that refers to column E (not C).

You then go through another loop of the worksheets in the same workbook. Why not add the new worksheet at the start of the macro and only have one loop?

As there is no data in column C, on which the size of 'myrg' is based, you only clear/overwrite 1 or 2 of the many currency cells populated in column F. I'm not sure whether you intend to clear these, or to write to and copy from a different column.

I thought that, in my last code, I had removed two duplicate statements that might be confusing the program:

Code

With wksSummary 
                    If wks.Name <> .Name Then 


                    End If 
                End With

If not, these should be removed, in particular the 'With wksSummary' as having that With inside the same With may well cause confusion.

I would need to understand a little more clearly what data you intend to work on in order to determine how best to change what you have.

VBA, Advanced Filter

Participate now!

Share