Question

Please help - I've been searching for hours and am having no luck! I'm using Power Query to bring in results from a SQL script. This information updates everytime I open the spreadsheet. Once the information has updated, I would like to delete Rows which have a date in Column C that is greater than today, so they don't get calculated in my VLOOKUP on another sheet. I've tried the following:

Private Sub Workbook_Open()
Dim LR As Long, I As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LR = Range("C" & Rows.Count).End(xlUp).Row
For I = LR To 1 Step -1
    If Range("C" & I).Value > Date Then Rows(I).Delete
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

This however doesn't run automatically, and when running it manually it gives "Run-time error '1004': Application-defined or object-defined error" and then proceeds to delete incorrect dates.

I also tried this, but it also deletes the incorrect dates and gives me Run-time error.

Sub DeleteCells()
Dim LR As Long, I As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LR = Range("C" & Rows.Count).End(xlUp).Row
For I = LR To 1 Step -1
If Range("C" & I).Value > Date Then Rows(I).Delete
Next I
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Était-ce utile?

La solution

EDIT 4/11: I am guessing that the 1004 error occurred because all of the "Branch Not Open" rows had been previously removed. The updated code below wraps an if statement around the autofilter step, which should now only be applied if at least one match for "Branch Not Open" is found in the filter range. Hopefully this version works!

@SickDimension is off to a great start -- but since you know that a number of rows are going to have "Branch Not Open" listed in the "Live Date" column you can remove them quickly using the autofilter. Try this code out (with an update for the LR code too):

Private Sub Workbook_Open()
Dim LR As Long, LC As Long, I As Long
Dim FilterRng As Range
Dim DataSheet As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'assign worksheet to save time in references
Set DataSheet = ThisWorkbook.Worksheets("Clocking Exceptions")

'Define your filter range as the block of data
LC = DataSheet.Range("A3").End(xlToRight).Column
With DataSheet
    LR = .Range("C" & .Rows.Count).End(xlUp).Row
End With

Set FilterRng = Range(DataSheet.Cells(3, 1), DataSheet.Cells(LR, LC))

'autofilter the sheet to remove "Branch Not Open" rows
If Not FilterRng.Find(What:="Branch Not Open", LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
    With FilterRng
        .AutoFilter Field:=3, Criteria1:="Branch Not Open", Operator:=xlAnd
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    DataSheet.AutoFilterMode = False
End If

For I = LR To 1 Step -1
    If IsDate(DataSheet.Range("C" & I).Value) Then
        If DateValue(DataSheet.Range("C" & I).Value) > DateValue(Date) Then Rows(I).Delete
    End If
Next I

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Autres conseils

If you need to use it upon opening file, you should specify the sheet you want it to run as upon opening file there is no range/sheet selected there for error '1004' ;) for ex.

'Following line needs to be defined more accurately
    Range("C" & I).Value
'Redefine
    Sheets("Sheet1").Range("C" & I).Value

Other wise the following will work, add the DateValue() to make the comparioson with the date values -

    If DateValue(Range("C" & I).Value) > DateValue(Date) Then Rows(I).Delete

The solution

Private Sub Workbook_Open()
Dim LR As Long, I As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LR = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row

For I = LR To 1 Step -1
    If IsDate(Sheets("Sheet1").Range("C" & I).Value) Then
        If DateValue(Sheets("Sheet1").Range("C" & I).Value) > DateValue(Date) Then Rows(I).Delete
    End If
Next I

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top