Filter Last month bringing back unwanted records

Damian37

Active Member
Joined
Jun 9, 2014
Messages
301
Office Version
  1. 365
Hello All,
I've written code to randomly select 10% of data from a data tab within the workbook I've built the macro to do. However, when I review the data, the results contain dates outside of the Last Month timeframe. I've tried changing the format of the column that contains the dates I'm checking to a Short Date format, but that hasn't work the way I would like. I've included the code in this post. I haven't been able to ffigure out why the results aren't staying within the parameters set up in the VBA code. I've also pasted a screenshot showing wrong dates that shouldn't have been copied over.
VBA Code:
Sub Filter_by_Last_month()
'
' Filter_by_month Macro

    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Sheets("FILENAME").Range("A:I").AutoFilter Field:=9, Criteria1:=xlFilterLastMonth, _
    Operator:=xlFilterDynamic

'Sub CreateSheet()
Application.DisplayAlerts = False
 
  On Error Resume Next
  Sheets("Sheet1").Delete
  On Error GoTo 0
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "Sheet1"

'Sub Copy_Header()
Application.ScreenUpdating = False
Dim h As Long

    For h = 2 To Sheets.Count
        Sheets("FILENAME").Rows(1).Copy Destination:=Sheets("Sheet1").Rows(1)
    Next
Sheets("Sheet1").Cells(1, 1).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True

'Sub Copy()
Dim LastRow As Long
Dim NbRows As Long
Dim RowList()
Dim i As Long, J As Long, k As Long
Dim RowNb As Long
Dim s As String
Sheets("FILENAME").Activate


Application.ScreenUpdating = False
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    s = i & ":" & i
    If IsEmpty(Cells(i, 1).Value) Then
         Rows(s).EntireRow.Hidden = False
    End If
Next
Application.ScreenUpdating = True
    
    
    Sheets("FILENAME").Activate
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    NbRows = LastRow * 0.1
    ReDim RowList(1 To NbRows)
    k = 2
    For i = 1 To NbRows
        RowNb = Rnd() * LastRow
        Rows(RowNb).Copy Destination:=Sheets("Sheet1").Cells(k, "A")
        k = k + 1
NextStep:
    Next i
End Sub

This is a screeenshot of my results. If you review the Disposition Date column you can see there are dates that aren't in November. Any help I can get is greatly apprecaiated.

1703196128805.png
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Hi Damian, I can think of another way of doing this - are you able to share your actual file via Google Drive, Dropbox or similar file sharing platform?
 
Upvote 0
Upvote 0
Hi Damian,
I wouldn't bother deleting the "Sheet1" every time then adding it again, rather I would simply clear that sheet for reuse. Please review the amended file, Link: Alerts-AML - VBA - Template -Curr & Last Month unfinished.xlsm
I've taken the liberty of calling the Sheet1 - "RANDOM RECORDS' instead. If you change that, you'll need to change its reference within the code as well. I notice you had code for the current month as well, I've included code for that too. Here is the code:
VBA Code:
Option Explicit
Sub Filter_by_current_month()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("FILENAME")
    Set ws2 = Worksheets("RANDOM RECORDS")
    
    'Filter & copy current month records
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 9, 7, 11
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A2")
        Else
            MsgBox "No records found for the current month"
            .AutoFilter
            Exit Sub
        End If
        .AutoFilter
    End With
    
    'Randomise the records & show 10% only
    Dim LRow As Long, LCol As Long, i As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    With ws2
        With .Range(.Cells(2, LCol), .Cells(LRow, LCol))
            .Formula = "=Rand()"
        End With
        .Range("A1").CurrentRegion.Sort key1:=ws2.Cells(2, LCol), order1:=xlAscending, Header:=xlYes
        .Columns(LCol).ClearContents
        .Rows(Int((LRow - 1) / 10) + 2 & ":" & LRow).Delete
    End With
End Sub

Sub Filter_by_last_month()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("FILENAME")
    Set ws2 = Worksheets("RANDOM RECORDS")
    
    'Filter & copy prior month records
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 9, 8, 11
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A2")
        Else
            MsgBox "No records found for last month"
            .AutoFilter
            Exit Sub
        End If
        .AutoFilter
    End With
    
    'Randomise the records & show 10% only
    Dim LRow As Long, LCol As Long, i As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    With ws2
        With .Range(.Cells(2, LCol), .Cells(LRow, LCol))
            .Formula = "=Rand()"
        End With
        .Range("A1").CurrentRegion.Sort key1:=ws2.Cells(2, LCol), order1:=xlAscending, Header:=xlYes
        .Columns(LCol).ClearContents
        .Rows(Int((LRow - 1) / 10) + 2 & ":" & LRow).Delete
    End With
End Sub

When running the Sub Filter_by_last_month() - this is the result I get with your sample data:
Alerts-AML - VBA - Template -Curr & Last Month unfinished.xlsm
ABCDEFGHIJKLM
1Alert NumberAcknowledgement DateProductModuleAgentRiskDateMember NameDisposition DateAcknowledgement NoteAcknowledgement ReasonAlert StateResult State
2194905682023-11-06 3:04:36BSA/AMLGenericGeneric901-Oct-23Generic6/11/2023GenericOtherAcknowledgedAlert
3153003602023-11-06 3:22:53BSA/AMLGenericGeneric891-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
4195016762023-11-10 7:51:58BSA/AMLGenericGeneric992-Nov-23Generic10/11/2023GenericOtherAcknowledgedAlert
5195011092023-11-06 7:51:48BSA/AMLGenericGeneric832-Nov-23Generic6/11/2023GenericOtherAcknowledgedAlert
6195022792023-11-13 5:50:08BSA/AMLGenericGeneric992-Nov-23Generic13/11/2023GenericOtherAcknowledgedAlert
7195002242023-11-09 6:35:42BSA/AMLGenericGeneric872-Nov-23Generic9/11/2023GenericOtherAcknowledgedAlert
8136428212023-11-06 3:08:38BSA/AMLGenericGeneric821-Aug-23Generic6/11/2023GenericOtherAcknowledgedAlert
9195018252023-11-07 4:52:57BSA/AMLGenericGeneric862-Nov-23Generic7/11/2023GenericOtherAcknowledgedAlert
10194989792023-11-06 6:20:40BSA/AMLGenericGeneric792-Nov-23Generic6/11/2023GenericOtherAcknowledgedAlert
11152986682023-11-06 4:05:01BSA/AMLGenericGeneric941-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
12195020662023-11-10 4:36:02BSA/AMLGenericGeneric992-Nov-23Generic10/11/2023GenericOtherAcknowledgedAlert
13152992672023-11-06 3:19:45BSA/AMLGenericGeneric911-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
14194906992023-11-06 3:46:54BSA/AMLGenericGeneric931-Oct-23Generic6/11/2023GenericOtherAcknowledgedAlert
15195012692023-11-06 7:39:29BSA/AMLGenericGeneric822-Nov-23Generic6/11/2023GenericOtherAcknowledgedAlert
16194906742023-11-03 8:27:44BSA/AMLGenericGeneric821-Oct-23Generic3/11/2023GenericOtherAcknowledgedAlert
17194894252023-11-06 3:07:51BSA/AMLGenericGeneric991-Oct-23Generic6/11/2023GenericOtherAcknowledgedAlert
18131379142023-11-06 4:05:25BSA/AMLGenericGeneric991-Jun-23Generic6/11/2023GenericOtherAcknowledgedAlert
19136412742023-11-06 3:50:20BSA/AMLGenericGeneric811-Aug-23Generic6/11/2023GenericOtherAcknowledgedAlert
20136423962023-11-06 3:37:14BSA/AMLGenericGeneric931-Aug-23Generic6/11/2023GenericOtherAcknowledgedAlert
21153004962023-11-06 3:22:33BSA/AMLGenericGeneric991-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
22
RANDOM RECORDS
 
Upvote 0
Solution
Hi Damian,
I wouldn't bother deleting the "Sheet1" every time then adding it again, rather I would simply clear that sheet for reuse. Please review the amended file, Link: Alerts-AML - VBA - Template -Curr & Last Month unfinished.xlsm
I've taken the liberty of calling the Sheet1 - "RANDOM RECORDS' instead. If you change that, you'll need to change its reference within the code as well. I notice you had code for the current month as well, I've included code for that too. Here is the code:
VBA Code:
Option Explicit
Sub Filter_by_current_month()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("FILENAME")
    Set ws2 = Worksheets("RANDOM RECORDS")
   
    'Filter & copy current month records
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 9, 7, 11
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A2")
        Else
            MsgBox "No records found for the current month"
            .AutoFilter
            Exit Sub
        End If
        .AutoFilter
    End With
   
    'Randomise the records & show 10% only
    Dim LRow As Long, LCol As Long, i As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    With ws2
        With .Range(.Cells(2, LCol), .Cells(LRow, LCol))
            .Formula = "=Rand()"
        End With
        .Range("A1").CurrentRegion.Sort key1:=ws2.Cells(2, LCol), order1:=xlAscending, Header:=xlYes
        .Columns(LCol).ClearContents
        .Rows(Int((LRow - 1) / 10) + 2 & ":" & LRow).Delete
    End With
End Sub

Sub Filter_by_last_month()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("FILENAME")
    Set ws2 = Worksheets("RANDOM RECORDS")
   
    'Filter & copy prior month records
    If ws1.AutoFilterMode Then ws1.AutoFilter.ShowAllData
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 9, 8, 11
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A2")
        Else
            MsgBox "No records found for last month"
            .AutoFilter
            Exit Sub
        End If
        .AutoFilter
    End With
   
    'Randomise the records & show 10% only
    Dim LRow As Long, LCol As Long, i As Long
    LRow = ws2.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    With ws2
        With .Range(.Cells(2, LCol), .Cells(LRow, LCol))
            .Formula = "=Rand()"
        End With
        .Range("A1").CurrentRegion.Sort key1:=ws2.Cells(2, LCol), order1:=xlAscending, Header:=xlYes
        .Columns(LCol).ClearContents
        .Rows(Int((LRow - 1) / 10) + 2 & ":" & LRow).Delete
    End With
End Sub

When running the Sub Filter_by_last_month() - this is the result I get with your sample data:
Alerts-AML - VBA - Template -Curr & Last Month unfinished.xlsm
ABCDEFGHIJKLM
1Alert NumberAcknowledgement DateProductModuleAgentRiskDateMember NameDisposition DateAcknowledgement NoteAcknowledgement ReasonAlert StateResult State
2194905682023-11-06 3:04:36BSA/AMLGenericGeneric901-Oct-23Generic6/11/2023GenericOtherAcknowledgedAlert
3153003602023-11-06 3:22:53BSA/AMLGenericGeneric891-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
4195016762023-11-10 7:51:58BSA/AMLGenericGeneric992-Nov-23Generic10/11/2023GenericOtherAcknowledgedAlert
5195011092023-11-06 7:51:48BSA/AMLGenericGeneric832-Nov-23Generic6/11/2023GenericOtherAcknowledgedAlert
6195022792023-11-13 5:50:08BSA/AMLGenericGeneric992-Nov-23Generic13/11/2023GenericOtherAcknowledgedAlert
7195002242023-11-09 6:35:42BSA/AMLGenericGeneric872-Nov-23Generic9/11/2023GenericOtherAcknowledgedAlert
8136428212023-11-06 3:08:38BSA/AMLGenericGeneric821-Aug-23Generic6/11/2023GenericOtherAcknowledgedAlert
9195018252023-11-07 4:52:57BSA/AMLGenericGeneric862-Nov-23Generic7/11/2023GenericOtherAcknowledgedAlert
10194989792023-11-06 6:20:40BSA/AMLGenericGeneric792-Nov-23Generic6/11/2023GenericOtherAcknowledgedAlert
11152986682023-11-06 4:05:01BSA/AMLGenericGeneric941-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
12195020662023-11-10 4:36:02BSA/AMLGenericGeneric992-Nov-23Generic10/11/2023GenericOtherAcknowledgedAlert
13152992672023-11-06 3:19:45BSA/AMLGenericGeneric911-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
14194906992023-11-06 3:46:54BSA/AMLGenericGeneric931-Oct-23Generic6/11/2023GenericOtherAcknowledgedAlert
15195012692023-11-06 7:39:29BSA/AMLGenericGeneric822-Nov-23Generic6/11/2023GenericOtherAcknowledgedAlert
16194906742023-11-03 8:27:44BSA/AMLGenericGeneric821-Oct-23Generic3/11/2023GenericOtherAcknowledgedAlert
17194894252023-11-06 3:07:51BSA/AMLGenericGeneric991-Oct-23Generic6/11/2023GenericOtherAcknowledgedAlert
18131379142023-11-06 4:05:25BSA/AMLGenericGeneric991-Jun-23Generic6/11/2023GenericOtherAcknowledgedAlert
19136412742023-11-06 3:50:20BSA/AMLGenericGeneric811-Aug-23Generic6/11/2023GenericOtherAcknowledgedAlert
20136423962023-11-06 3:37:14BSA/AMLGenericGeneric931-Aug-23Generic6/11/2023GenericOtherAcknowledgedAlert
21153004962023-11-06 3:22:33BSA/AMLGenericGeneric991-Sep-23Generic6/11/2023GenericOtherAcknowledgedAlert
22
RANDOM RECORDS
Hey Kevin,
Thanks so much for helping me with this. However, the requestor has asked the Date within column G (Disposition Date) be used instead of column B (Acknowledgement Data). I ran the code, and it appears to be working as I received a message box for both current and prior month data. I have requested a current data file to test with. I cannot thank you enough. I was also hoping you might be able to correspond directly to go over some questions I have regarding the code you used, I would very much like to increase my understanding of VBA so I can provide solutions, like you, instead of only providing issues. Let me know what you think. Hope you have a very Happy New Year!

D.
 
Upvote 0
Glad to help Damian & thanks for the feedback (y) :)
As a point of interest, the code I provided does use the dates in column I (Disposition date)
 
Upvote 0
Glad to help Damian & thanks for the feedback (y) :)
As a point of interest, the code I provided does use the dates in column I (Disposition date)
Cool, thank you so much. I should’ve taken that out since I couldn’t see results with the data I had.
 
Upvote 0

Forum statistics

Threads
1,224,814
Messages
6,181,124
Members
453,021
Latest member
Justyna P

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