Hi All,
I have a macro created to delete rows based on dates in column g. This works fine but I cant seem to loop it to run through all the sheets in the workbook?
Code:
Sub ScrubData()
Dim i As Long
Dim numRowsWithVal As Long
Dim myActiveCell As Range
Dim todaysDate As Date
Dim cutoffDate As Date
'Use a custom function to delete all blank rows in column specified
Call DeleteAllBlankRowsInColumn("G")
'Use VBA's Date() function to get current date (i.e. 3/13/14)
todaysDate = Date
'***** Loop through all rows and clear values if rows are equal to today's date or older than 8 days ******
'Count the number of rows with values (subtract one because sheet has headers)
numRowsWithVal = (Range("G" & Rows.Count).End(xlUp).Row) - 1
'Start at Range("G2")
Set myActiveCell = ActiveSheet.Range("G2")
For i = 0 To numRowsWithVal - 1
Select Case True
'If value of cell is today's date OR older than 8 days clear the values
Case myActiveCell.Offset(i, 0).Value <= todaysDate
myActiveCell.Offset(i, 0).ClearContents
'Value is valid, do nothing
Case Else
End Select
Next
'***********************************************************************************************************
'Now that values are cleared, delete all blank rows again
Call DeleteAllBlankRowsInColumn("G")
'Declaring variables
Dim LastRow As Long
Dim Rng As Range
'Getting row number of last cell
LastRow = Range("G1").SpecialCells(xlCellTypeLastCell).Row
'Selecting all data
Set Rng = Range("G2:G" & LastRow)
'Selecting Blank cells
Rng.SpecialCells(xlCellTypeBlanks).Select
'Deleting complete row
Selection.EntireRow.Delete
Range("G2").Select
End Sub
Public Function DeleteAllBlankRowsInColumn(ByVal columnLetter As String)
'Delete all blank rows in column specified (suppress errors just in case there aren't any blank cells)
On Error Resume Next
Columns(columnLetter).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Set error handling back to normal
End Function
I have a macro created to delete rows based on dates in column g. This works fine but I cant seem to loop it to run through all the sheets in the workbook?
Code:
Sub ScrubData()
Dim i As Long
Dim numRowsWithVal As Long
Dim myActiveCell As Range
Dim todaysDate As Date
Dim cutoffDate As Date
'Use a custom function to delete all blank rows in column specified
Call DeleteAllBlankRowsInColumn("G")
'Use VBA's Date() function to get current date (i.e. 3/13/14)
todaysDate = Date
'***** Loop through all rows and clear values if rows are equal to today's date or older than 8 days ******
'Count the number of rows with values (subtract one because sheet has headers)
numRowsWithVal = (Range("G" & Rows.Count).End(xlUp).Row) - 1
'Start at Range("G2")
Set myActiveCell = ActiveSheet.Range("G2")
For i = 0 To numRowsWithVal - 1
Select Case True
'If value of cell is today's date OR older than 8 days clear the values
Case myActiveCell.Offset(i, 0).Value <= todaysDate
myActiveCell.Offset(i, 0).ClearContents
'Value is valid, do nothing
Case Else
End Select
Next
'***********************************************************************************************************
'Now that values are cleared, delete all blank rows again
Call DeleteAllBlankRowsInColumn("G")
'Declaring variables
Dim LastRow As Long
Dim Rng As Range
'Getting row number of last cell
LastRow = Range("G1").SpecialCells(xlCellTypeLastCell).Row
'Selecting all data
Set Rng = Range("G2:G" & LastRow)
'Selecting Blank cells
Rng.SpecialCells(xlCellTypeBlanks).Select
'Deleting complete row
Selection.EntireRow.Delete
Range("G2").Select
End Sub
Public Function DeleteAllBlankRowsInColumn(ByVal columnLetter As String)
'Delete all blank rows in column specified (suppress errors just in case there aren't any blank cells)
On Error Resume Next
Columns(columnLetter).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Set error handling back to normal
End Function