If cell in next month need to delete rows in table

[Eric Penfold]

This code needs to delete any table rows which are next month. The Dims etc. are correct so i can`t workout why it`s not depleting the next month lines ??

With tblDailyMail.DataBodyRange
            For Rw = .Rows.Count To 1 Step -1
                For Each Cell In .Range("A2:A" & LRow)
                    intDaysInMonth = Day(DateSerial(Year(Now()), Month(Now()) + 1, 0))
                    For x = 1 To intDaysInMonth
                        If Not Cell = DateSerial(Year(Now()), Month(Now()), x) Then
                            .ListRows(Rw).Delete
                        End If
                    Next x
                Next Cell
            Next Rw
        End With

 

[Peter_SSs]

Perhaps you could give us some sample data with XL2BB and explain what the code is doing and what it should be doing?

It might also help if you gave us the full code rather than a snippet.

 

[Eric Penfold]

List above needs to be only this month figurers so all cells with 01/01/2024 and beyond the rows need to be deleted.

Option Explicit
Sub Mouthly_DailyMail_Figurers()

    Dim CopyToRange As Range
    Dim PasteToRange As Range
    Dim Rng    As Range
    Dim Cell   As Range
    Dim Rng1   As Range, Rng2 As Range, Rng3 As Range, RngLoop As Range
    Dim LRow   As Long
    Dim wb     As Workbook
    Dim ws     As Worksheet
    Dim swb    As Workbook
    Dim sws    As Worksheet
    Dim pwb    As Workbook
    Dim pws    As Worksheet
    Dim tblDailyMail As Object
    Dim FileToOpen As Variant

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .DisplayAlerts = False
    End With
    
    Set swb = ActiveWorkbook
    Set sws = swb.Sheets("Sheet")
    Set pwb = Workbooks("MyPersonal.xlsb")
    Set pws = pwb.Worksheets("DailyMail")
    FileToOpen = ("S:\SALES\REPORTING\2023\DailyMail.xlsx")
    Workbooks.Open FileToOpen
    Set wb = Workbooks("DailyMail.xlsx")
    Set ws = wb.Worksheets("Daily Mail Update")
    LRow = pws.Cells(Rows.Count, 1).End(xlUp).Row
    Set RngLoop = pws.Range("I2:I" & LRow)
    
    Set Rng1 = sws.Range("A2")
    Set Rng2 = sws.Range("B2")
    Set Rng3 = sws.Range("C2")
    
    With ws
        For Each Cell In RngLoop
            If Cell.Value Like "Total Value*" Then
                Cell.Offset(0, 2).Value = Rng1.Value
            End If
            If Cell.Value Like "*GP%*" Then
                Cell.Offset(0, 2).Value = Rng3.Value
            End If
        Next Cell
        
        Set tblDailyMail = .ListObjects("Daily_Mail_Data")
        For Each Cell In tblDailyMail.ListColumns("Sales").DataBodyRange
            If Not WorksheetFunction.IsText(Cell.Value) Then
                Cell.Value = sws.Range("A2").Value
                Cell.Font.Name = "Arial"
                Cell.Font.Size = 11
                .Range("H35") = Rng1
                .Range("I35") = Rng2
                GoTo CloseDailyMail
            End If
        Next Cell
    End With
    
CloseDailyMail:
    
    Call DailyMail_Chart_Update
    Workbooks("DailyMail.xlsx").Save
'    Workbooks("DailyMail.xlsx").Close
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
        .DisplayAlerts = True
    End With
    
    MsgBox ("Daily Mail Mountly Figurers Updated")
    
End Sub

 

[Eric Penfold]

Found a way of simply filtering the column then deleting next month rows see below. Thought I would let you see it works very well.

With tblDailyMail.DataBodyRange
        .AutoFilter field:=1, Criteria1:=xlFilterNextMonth, Operator:=xlFilterDynamic
        .SpecialCells(xlCellTypeVisible).Delete
        .AutoFilter.ShowAllData
        End With