How to Loop Macro through all worksheets

[haider200]

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

 

[Norie]

I don't see any code for looping through sheets, or for DeleteAllBlankRowsInColumn which I presume has the code you want to run on all the sheets.

 

[haider200]

I don't see any code for looping through sheets, or for DeleteAllBlankRowsInColumn which I presume has the code you want to run on all the sheets.

I tried different codes, as in 'dim ws worksheets' etc. The first part of that code looks at column g, identifies those cells with a date before todays date and makes them blank. Then the second part identifies the blanks and deletes these. I just need a loop input

 

[haider200]

This is the code with tags (there is no loop input this is what I need):

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

 

[DataBlake]

here is how to loop through sheets

Sub loopworksheet()
Dim y As Long

For y = 1 To ActiveWorkbook.Worksheets.Count
    Sheets(y).Range("A1").Value = 1 'replace code here
Next y

End Sub

y is representative of the sheet loop in my example
just replace the example in between the for loop with your adapted code using Sheets( y )