VBA to filter Data

[bkramer1]

Good Evening and thank you for coming to my Aid!

I would like the data on worksheet "List of accounts" to filter and display only the newest date in "Column N". How can I add this at the end of my VBA?


Sub Pivot_Refresh()

Dim ws As Worksheet
Set ws = Worksheets("List of all accounts")
If ws.Application.WorksheetFunction.CountBlank(ws.Range("O2:O199")) > 0 Then
MsgBox "There Are Blank Cells in Range O2:O199"
Else

Dim Table As PivotTable
Set Table = ActiveSheet.PivotTables("PivotTable3")

Table.RefreshTable

Dim shtP As Worksheet
Dim shtL As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim DateString As String
Dim LRow1 As Long
Dim LRow2 As Long

Set shtP = Sheets("Pivot")
Set shtL = Sheets("List of all Accounts")
Set pt = shtP.PivotTables("PivotTable3")
Set pf = pt.PivotFields("date")
DateString = Format(Now(), "m/d/yyyy")
LRow1 = shtL.Range("A" & Rows.Count).End(xlUp).Row + 1

ActiveSheet.PivotTables ("PivotTable3")

For Each pi In pf.PivotItems
If pi.Value <> DateString Then
End If
Next pi

shtL.Range("A2:O199").Copy shtL.Cells(LRow1, "A")

LRow2 = shtL.Range("A" & Rows.Count).End(xlUp).Row

If ws.Application.WorksheetFunction.Weekday(ws.Range("N2") + 1) = 6 Then
shtL.Range("N2:N199").Value = shtL.Range("N2").Value + 4
Else

shtL.Range("N2:N199").Value = shtL.Range("N2").Value + 1
End If

shtL.Range("O2:O199").ClearContents

MsgBox "Now Filter B1 to todays Date"
End If

End Sub

[TMS]

How can I add this at the end of my VBA?

Record a macro while you do it manually. Then copy and paste the code into your routine. It'll probably need some tweaking for ranges, etc.

[bkramer1]

Thanks,

I originally wanted to have the sheet filter by newly added data which wouldn't have been availabe prior to running the VBA. So macro recording wouldn't have worked. However after I played around with the VBA a little I realized I could just have the filter look for blank cells. I rewrote the vba and it works perfectly for my purposes now.

Thank you for your suggestion.

Sub Pivot_Refresh()

Dim ws As Worksheet
Set ws = Worksheets("List of all accounts")
If ws.Application.WorksheetFunction.CountBlank(ws.Range("O2:O199")) > 0 Then
MsgBox "There Are Blank Cells in Range O2:O199"
Else

Dim Table As PivotTable
Set Table = ActiveSheet.PivotTables("PivotTable3")

Table.RefreshTable

Dim shtP As Worksheet
Dim shtL As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim DateString As String
Dim LRow1 As Long
Dim LRow2 As Long

Set shtP = Sheets("Pivot")
Set shtL = Sheets("List of all Accounts")
Set pt = shtP.PivotTables("PivotTable3")
Set pf = pt.PivotFields("date")
DateString = Format(Now(), "m/d/yyyy")
LRow1 = shtL.Range("A" & Rows.Count).End(xlUp).Row + 1

ActiveSheet.PivotTables ("PivotTable3")

For Each pi In pf.PivotItems
If pi.Value <> DateString Then
End If
Next pi

shtL.Range("A2:O199").Copy shtL.Cells(LRow1, "A")

LRow2 = shtL.Range("A" & Rows.Count).End(xlUp).Row

If ws.Application.WorksheetFunction.Weekday(ws.Range("N2") + 1) = 6 Then
shtL.Range("N2:N199").Value = shtL.Range("N2").Value + 4
Else

shtL.Range("N2:N199").Value = shtL.Range("N2").Value + 1
End If

shtL.Range("O2:O199").ClearContents

MsgBox "Now Filter B1 to todays Date"

shtL.Range("O1").AutoFilter Field:=15, Criteria1:=""

End If
End Sub

[TMS]

You're welcome.



If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save


You may also want to consider thanking those people who helped you by clicking on the little star at the bottom left of their reply to your question.