VBA Autofilter

[cloos]

Hi -

I have this really clumsy code that is slowing my macro down (pasted below) I need to loop through a page using the auto filter for several variables and then get the value and paste it into a table. Below is what I wrote, I could not figure out how to loop this so I have pasted this section 30 times... ouch! .... The only change for each section is the auto filter range is increased by one. ie J7, J8, J9, J10 ect. Any ideas would be a great help.

Sheets("Database").Activate
ActiveSheet.Range("Dbase").AutoFilter Field:=8, Criteria1:=Worksheets("Part Nbr Check").Range("J7")
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Part Nbr Check").Select
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Review").Select
Range("M8").Select
Selection.End(xlDown).Select
ActiveCell.Resize(1, 2).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("P11").Select
ActiveCell.FormulaR1C1 = "='Part Nbr Check'!R[-4]C[-6]"
Range("P11").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

 

[JLGWhiz]

Are you sure that incrementing the rows in column J is the only change in the procedure. See my comments in the procedure below.

Sub copyStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = Sheets(1) '("Database")
Set sh2 = Sheets(2) '("Part Nbr Check")
Set sh3 = Sheets(3) '("Review")
    For i = 7 To 36
        sh1.Range("Dbase").AutoFilter 8, sh2.Range("J" & i)
        sh1.Range("Dbase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
        sh2.Range("M1").PasteSpecial xlPasteValues ' This will overwrite with each subsequent iteration
        sh3.Range("M8").End(xlDown).Resize(1, 2).Copy sh3.Range("M8").End(xlDown)(2)
            With sh3.Range("M8").End(xlDown).Offset(-1, 0).Resize(1, 2)
                .Value = .Value
            End With
        sh3.Range("P11") = sh2.Range("J7") 'This will just repeat over and over for each iteration
        Application.CutCopyMode = False
    Next
End Sub

Post back with results

 

[cloos]

Thank you, I can't tell you how stuck I was. And you are correct the Range ("P11") changes one cell down for each iteration. Not sure how to handle that either.

 

[cloos]

Thank you, I can't tell you how stuck I was. And you are correct the Range ("P11") changes one cell down for each iteration. Not sure how to handle that either.

 

[JLGWhiz]

Thank you, I can't tell you how stuck I was. And you are correct the Range ("P11") changes one cell down for each iteration. Not sure how to handle that either.

Modify the P11 line as follows

        sh3.Range("P" & i + 4) = sh2.Range("J7")

How about the M1 Overwrite? Each filtered data set will overwrite the previous one if left as is.

 

[cloos]

Yes the M1 overwrite is suppose to do that to create a BOM based on user inputs. The only thing that is not working is the sh1.Range("Dbase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy code line. It is only highlighting 2 cells. I changed it a few different ways to highlight the data but continues to highlight the entire row and then I get a paste error because the point where it pastes isn't in column A. It shouldn't have anything to do with Dbase being a dynamic range, right? But it is fine, I will just create another sheet to put the values on. Unless you have an idea. But thanks again, I was really stuck and I am just getting the hang of these counting loops.

 

[JLGWhiz]

Yes the M1 overwrite is suppose to do that to create a BOM based on user inputs. The only thing that is not working is the sh1.Range("Dbase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy code line. It is only highlighting 2 cells. I changed it a few different ways to highlight the data but continues to highlight the entire row and then I get a paste error because the point where it pastes isn't in column A. It shouldn't have anything to do with Dbase being a dynamic range, right? But it is fine, I will just create another sheet to put the values on. Unless you have an idea. But thanks again, I was really stuck and I am just getting the hang of these counting loops.

this line

sh1.Range("Dbase").Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy

only moves the entire range parameter down one row to eliminate the headers. If you are not getting the range you expect, you can check the parameters in the Name Manager on the ribbon under Formulas. It worked correctly for me in testing and should not need any adjustment to the code. Just make sure your named range refers to the correct address. If that is it, I will leave you to work it out.
Regards, JLG

 

[cloos]

Thank you again, I was able to create a new sheet and get it to work so it's fine. I realize how the offset works so I even tried to put (1,13) but the result was highlighting the entire row, then I tried adjusting how many filters I have ... same thing. It must be the dynamic range or maybe something else, I don't know.

 

[JLGWhiz]

Thank you again, I was able to create a new sheet and get it to work so it's fine. I realize how the offset works so I even tried to put (1,13) but the result was highlighting the entire row, then I tried adjusting how many filters I have ... same thing. It must be the dynamic range or maybe something else, I don't know.

I set a range A6:H20 and used the code to filter that range and copy the filtered data. I named the range the same as yours and used the same code that I posted. It copied columns A:H of the filtered data, minus the headers, just as it should. Don't know why yours would be any different.