Looking for Macro to Populate a Table Based on Date Ranges

Hello RTM1,

I have added the macro below to the attached workbook. The macro runs after the end date has been entered.

Macro Code

'Written: March 22, 2010
'Author:  Leith Ross

Sub Macro1A(ByVal StartDate As Variant, ByVal EndDate As Variant)

  Dim DateCell As Range
  Dim RawRng As Range
  Dim ResRng As Range
  Dim RngEnd As Range
  Dim RawWks As Worksheet
  Dim ResWks As Worksheet
  
   'Validate start and end are dates
    If Not IsDate(StartDate) Or Not IsDate(EndDate) Then
      MsgBox "Entry Error: You have entered an invalid date."
      Exit Sub
    End If
    
   'Automatically size the ranges
    Set RawWks = Worksheets("Raw Data")
    Set ResWks = Worksheets("Result")
  
    Set RawRng = RawWks.Range("A2:E2")
    Set RngEnd = RawWks.Cells(Rows.Count, RawRng.Column).End(xlUp)
    Set RawRng = IIf(RngEnd.Row < RawRng.Row, RawRng, RawWks.Range(RawRng, RngEnd))
    
    Set ResRng = ResWks.Range("F6:J6")
    Set RngEnd = ResWks.Cells(Rows.Count, ResRng.Column).End(xlUp)
    Set ResRng = IIf(RngEnd.Row < ResRng.Row, ResRng, ResWks.Range(ResRng, RngEnd))
    
     'Change date format to match what will be searched
      StartDate = Format(StartDate, "mm/dd/yy")
      EndDate = Format(EndDate, "mm/dd/yy")
            
     'Validate dates are in chronological order
      If CDate(StartDate) > CDate(EndDate) Then
        MsgBox "The Start Date must come before the End Date."
        Exit Sub
      End If
      
     'Find the Start Date and validate is within range
      Set StartDate = RawRng.Find(StartDate, , xlValues, xlWhole, xlByRows, xlNext, False)
      If StartDate Is Nothing Then
        MsgBox "The Start Date is out of range."
        Exit Sub
      End If
      
     'Find the End Date and validate it is within range
      Set EndDate = RawRng.Find(EndDate, , xlValues, xlWhole, xlByRows, xlNext, False)
      If EndDate Is Nothing Then
        MsgBox "The End Date is out of range."
        Exit Sub
      End If
      
     'Change the Raw Range variable to point to the Start and End Dates
      Set RawRng = RawWks.Range(StartDate, EndDate.Offset(0, 5))
      
     'Clear the old dates
      ResRng.ClearContents
     'Paste in the new dates
      ResRng.Resize(RawRng.Rows.Count, 5).Value = RawRng.Value
     
End Sub

'Result' Worksheet Change Event Code

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("C4")) Is Nothing Then Exit Sub
  
    Application.EnableEvents = False
    Application.ScreenUpdating = False
      Call Macro1A(Range("B4"), Range("C4"))
    Application.EnableEvents = True
    Application.ScreenUpdating = True
      
End Sub

Hello RTM1,

Here is the amended macro. I added a loop to check if EndDate is the last one. This macro will work correctly as long as all the dates are in ascending order. The attached workbook has the macro added.

'Written: March 24, 2010
'Author:  Leith Ross

Sub Macro1A(ByVal StartDate As Variant, ByVal EndDate As Variant)

  Dim DateCell As Range
  Dim RawRng As Range
  Dim ResRng As Range
  Dim RngEnd As Range
  Dim RawWks As Worksheet
  Dim ResWks As Worksheet
  
   'Validate start and end are dates
    If Not IsDate(StartDate) Or Not IsDate(EndDate) Then
      MsgBox "Entry Error: You have entered an invalid date."
      Exit Sub
    End If
    
   'Automatically size the ranges
    Set RawWks = Worksheets("Raw Data")
    Set ResWks = Worksheets("Result")
  
    Set RawRng = RawWks.Range("A2:E2")
    Set RngEnd = RawWks.Cells(Rows.Count, RawRng.Column).End(xlUp)
    Set RawRng = IIf(RngEnd.Row < RawRng.Row, RawRng, RawWks.Range(RawRng, RngEnd))
    
    Set ResRng = ResWks.Range("F6:J6")
    Set RngEnd = ResWks.Cells(Rows.Count, ResRng.Column).End(xlUp)
    Set ResRng = IIf(RngEnd.Row < ResRng.Row, ResRng, ResWks.Range(ResRng, RngEnd))
    
     'Change date format to match what will be searched
      StartDate = Format(StartDate, "mm/dd/yy")
      EndDate = Format(EndDate, "mm/dd/yy")
            
     'Validate dates are in chronological order
      If CDate(StartDate) > CDate(EndDate) Then
        MsgBox "The Start Date must come before the End Date."
        Exit Sub
      End If
      
     'Find the Start Date and validate is within range
      Set StartDate = RawRng.Find(StartDate, , xlValues, xlWhole, xlByRows, xlNext, False)
      If StartDate Is Nothing Then
        MsgBox "The Start Date is out of range."
        Exit Sub
      End If
      
     'Find the End Date and validate it is within range
      Set EndDate = RawRng.Find(EndDate, , xlValues, xlWhole, xlByRows, xlNext, False)
      If EndDate Is Nothing Then
        MsgBox "The End Date is out of range."
        Exit Sub
      End If
      
     'Is this the last End Date?
      Do While EndDate = EndDate.Offset(1, 0)
        Set EndDate = EndDate.Offset(1, 0)
      Loop
     
     'Change the Raw Range variable to point to the Start and End Dates
      Set RawRng = RawWks.Range(StartDate, EndDate.Offset(0, 5))
      
     'Clear the old dates
      ResRng.ClearContents
     'Paste in the new dates
      ResRng.Resize(RawRng.Rows.Count, 5).Value = RawRng.Value
     
End Sub