Loop through workbook and apply module to each monthly sheet

[TheJonWithNoH]

I have the following code set up to pull data from a raw data file which searches through a list of dates (column R) and returns the data from column C to monthly sheets (Jan, Feb, etc). In cells F1 and H1 on each of these monthly sheets is the first and last date of each month, respectively. How can I modify the code below to not just provide January's data ("Jan" sheet) but to loop through the entire year and return the data for those months?

Sub LoopRange()Application.ScreenUpdating = False


Dim iWS As Worksheet: Set iWS = ThisWorkbook.Sheets("Data")
Dim oWS As Worksheet: Set oWS = ThisWorkbook.Sheets("Jan")


Dim inputRange As Range: Set inputRange = iWS.Range("R5", iWS.Range("R5").End(xlDown))
Dim outputRange As Range: Set outputRange = oWS.Range("A28:A200")


Dim startDate As Date: startDate = oWS.Range("F1").Value
Dim endDate As Date: endDate = oWS.Range("H1").Value


Dim cRow As Long: cRow = 28
Dim iCell As Range, oCell As Range




For Each iCell In inputRange
    If iCell.Value >= startDate And iCell.Value <= endDate Then
        cRow = cRow + 1
        oWS.Range("A" & cRow).Value = iCell.Offset(0, -15).Value
    End If
Next iCell


ActiveSheet.Range("A29:A200").RemoveDuplicates Columns:=1, Header:=xlNo


Application.ScreenUpdating = True
End Sub

 

[Michael M]

Are there any sheets to be Excluded from the loop ?

 

[TheJonWithNoH]

Yes.... A "Setup" sheet and a "Data" sheet

 

[Michael M]

UNTESTED

Sub LoopRange()
Application.ScreenUpdating = False
Dim iWS As Worksheet: Set iWS = Sheets("Data")
Dim inputRange As Range: Set inputRange = iWS.Range("R5", iWS.Range("R5").End(xlDown))
Dim cRow As Long: cRow = 28
Dim iCell As Range, oCell As Range
Dim ws As Worksheet
Dim startDate As Date: startDate = ws.Range("F1").Value
Dim endDate As Date: endDate = ws.Range("H1").Value
Dim outputRange As Range: Set outputRange = ws.Range("A28:A200")
    For Each ws In Worksheets
        If ws.Name <> "Data" And ws.Name <> "Setup" Then
        ws.Activate
            For Each iCell In inputRange
                If iCell.Value >= startDate And iCell.Value <= endDate Then
                    cRow = cRow + 1
                    ws.Range("A" & cRow).Value = iCell.Offset(0, -15).Value
                End If
            Next iCell
        ActiveSheet.Range("A29:A200").RemoveDuplicates Columns:=1, Header:=xlNo
        End If
    Next ws
Application.ScreenUpdating = True
End Sub

 

[TheJonWithNoH]

Thank you...

I get a "Run-time error '91': Object Variable or With block variable not set "

Debug highlights the ": startDate = ws.Range("F1").Value"

 

[Michael M]

Still UNTESTED

Sub LoopRange()
Application.ScreenUpdating = False
Dim iWS As Worksheet: Set iWS = Sheets("Data")
Dim inputRange As Range: Set inputRange = iWS.Range("R5", iWS.Range("R5").End(xlDown))
Dim cRow As Long: cRow = 28
Dim iCell As Range, oCell As Range
Dim ws As Worksheet
Dim startDate As Date: startDate = Range("F1").Value
Dim endDate As Date: endDate = Range("H1").Value
Dim outputRange As Range: Set outputRange = Range("A28:A200")
    For Each ws In Worksheets
        If ws.Name <> "Data" And ws.Name <> "Setup" Then
        ws.Activate
            For Each iCell In inputRange
                If iCell.Value >= startDate And iCell.Value <= endDate Then
                    cRow = cRow + 1
                    ws.Range("A" & cRow).Value = iCell.Offset(0, -15).Value
                End If
            Next iCell
        ActiveSheet.Range("A29:A200").RemoveDuplicates Columns:=1, Header:=xlNo
        End If
    Next ws
Application.ScreenUpdating = True
End Sub