Hello- Learning VBA, trying to automate handling of task sheets I deal with at work. I started by listing the steps I want to accomplish, and then recording as many of them as possible, then trying to fill in the ones that could not be recorded.
I am getting stuck on trying to delete rows that have a date beyond 'next Sunday' in column H. I googled one part that is supposed to define 'next Sunday' as the date, and then another that us supposed to delete rows greater than that date. However, when I run it, for more rows are deleted than should be, as when I do this manually I am left with several more rows.
Any help would be greatly appreciated. Here is the code I am working with:
I am getting stuck on trying to delete rows that have a date beyond 'next Sunday' in column H. I googled one part that is supposed to define 'next Sunday' as the date, and then another that us supposed to delete rows greater than that date. However, when I run it, for more rows are deleted than should be, as when I do this manually I am left with several more rows.
Any help would be greatly appreciated. Here is the code I am working with:
VBA Code:
Sub bill_tasks()
'
' bill_tasks Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
Rows("1:2").Select
Selection.ClearContents
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
ActiveWorkbook.Worksheets("Task Detail - Pending R1067 - R").AutoFilter.Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Task Detail - Pending R1067 - R").AutoFilter.Sort. _
SortFields.Add2 Key:=Range("H3"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Task Detail - Pending R1067 - R").AutoFilter. _
Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim dNext_Sunday As Date
dNext_Sunday = DateAdd("d", -Weekday(Now) + 8, Now)
Application.ScreenUpdating = False
For i = Range("H1:H" & Cells(Rows.Count, "H").End(xlUp).Row).Rows.Count To 1 Step -1
If IsDate(Cells(i, "H")) And Cells(i, "H").Value > Date Then Cells(i, "H").EntireRow.Delete
Next i
Application.ScreenUpdating = True
Columns("D:D").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("D4").Select
Range(Selection, Selection.End(xlDown)).Select
End Sub