1
Sub filterData()
    Dim filterCriteria As String
    x = 1
    Do While Not IsEmpty(filterCriteria)
        filterCriteria = (Sheets("Lists").Cells(x, 2))
        Sheets(filterCriteria).Select
        Sheets(filterCriteria).Cells.Clear

        Range("A1") = "Date"
        Range("B1") = "Item"
        Range("C1") = "Category"
        Range("D1") = "Quantity"
        Range("E1") = "Rate"
        Range("F1") = "Total"
        Range("A1:F1").Font.Bold = True
        Range("A1:F1").Font.ColorIndex = 5
        Sheets("BookEntry").Select
        Dim lastRow As Long

        lastRow = Sheets("BookEntry").Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).row
        Dim lastColumn As Long

        lastColumn = Sheets("BookEntry").Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Column

        Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3, Criteria1:=filterCriteria
        Sheets("BookEntry").Range(Cells(2, 1), Cells(lastRow, lastColumn)).Copy
        Sheets(filterCriteria).Select
        erow = Sheets(filterCriteria).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row

        Sheets(filterCriteria).Paste Destination:=Worksheets(filterCriteria).Rows(erow)
        Sheets("BookEntry").Select
        Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3
        ActiveWorkbook.Save
        x = x + 1
    Loop
End Sub
Community
  • 1
  • 1
user252391
  • 13
  • 3

1 Answers1

2

You're doing two mistakes.

1- You are checking the filterCriteria before assigning it.

2- To check for an empty filterCriteria, you should check the string with Len(Trim(filterCriteria)) > 0, otherwise you should declare the variable as variant because IsEmpty works with variants. But the string option is better.

Change the structure of the loop into this:

x = 1
Dim filterCriteria As String
filterCriteria = Sheets("Lists").Cells(x, 2).value

Do While Len(Trim(filterCriteria)) > 0
    ...
    ...
    x = x + 1
    filterCriteria = Sheets("Lists").Cells(x, 2).value
Loop

Also try to get rid of those .Select stuff.

Community
  • 1
  • 1
A.S.H
  • 29,101
  • 5
  • 23
  • 50
  • Wow that was seriously fast! Thanks for your help A.S.H. I'll do my best to implement your advice. If I manage to get it to work, how do I mark this tread solved? – user252391 Mar 18 '17 at 08:17
  • Fantastic! That works perfectly. I kinda get what you mean but if you could possibly comment my original code that would be really helpful for me to learn. Also I don't know how to remove the .Select stuff. will my code still work without it? – user252391 Mar 18 '17 at 08:32
  • 1
    @user252391 - If A.S.H's answer solves your problem, you can show that by clicking on the "tick" that should be appearing to the left of the answer. That signifies that this is the answer that helped you the most, and will give him some extra "reputation" on the site. (And you gain a few extra rep points too when you do so.) – YowE3K Mar 18 '17 at 08:32
  • @user252391 the link I provided at the end of the answer is a perfect place to start about getting rid of the `Select stuff`. There are two excellent answers there, I advice you to read them carefully and practice their recommendations. – A.S.H Mar 18 '17 at 08:43
  • 1
    Thank you so much for your help A.S.H you have solved my problem making my workbook useful for me and set me on track to better coding too. I'm a very happy chappy!! – user252391 Mar 18 '17 at 08:49
  • Now it makes sense! :) – user252391 Mar 18 '17 at 08:52