Results 1 to 6 of 6

Thread: Loop through workbook and apply module to each monthly sheet
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Sep 2017
    Posts
    30
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Loop through workbook and apply module to each monthly sheet

    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?

    Code:
    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

  2. #2
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,806
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Loop through workbook and apply module to each monthly sheet

    Are there any sheets to be Excluded from the loop ?
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  3. #3
    New Member
    Join Date
    Sep 2017
    Posts
    30
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Loop through workbook and apply module to each monthly sheet

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

  4. #4
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,806
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Loop through workbook and apply module to each monthly sheet

    UNTESTED

    Code:
    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
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

  5. #5
    New Member
    Join Date
    Sep 2017
    Posts
    30
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Loop through workbook and apply module to each monthly sheet

    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"

  6. #6
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,806
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Loop through workbook and apply module to each monthly sheet

    Still UNTESTED

    Code:
    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
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •