MS Excel VBA Code - Simplest Way to Check if a Series of Dates is Between Two Dates and Enter Comment and Date in another Column

OilEconomist · Sep 19, 2022

Thanks in advance for any responses. What is the simplest and most efficient way to write VBA Code to check if a series of dates (columns A and B within "Sheet1") are within the dates (Columns B and C) of each row in "Sheet2" and add a comment if it is. The following is the VBA Code I wrote which works, but I would like to see if there is a simpler method. It runs fairly fast, but the data set is small. I thought about storing the data sets in Sheet1 into Scripting Dictionaries, but not sure how to retrieve and compare.

VBA Code:

Option Explicit
'***************************************************************************************************************
Sub DateRangeCheck()

 '_______________________________________________________________________________________________________
 'Turn off alerts, screen updates, and automatic calculation
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
            
            
  '_______________________________________________________________________________________________________
  'Dimensioning
  
    'Dim Longs
     Dim i As Long, j As Long, NoSL As Long, NLR_Sht2 As Long
    
    
    'Dim Strings
     Dim Sht1 As String, Sht2 As String
     Dim DataSet As String, CommentStr As String
     
     
    'Dim Dates
     Dim DateStart As Date, DateEnd As Date
     
     
    'Dim Ranges
     Dim aCell As Range, Rng As Range, Rng_Sht1_DS1 As Range, Rng_Sht1_DS2 As Range
 
 
    'Dim Timer Variables
     Dim BenchMark As Double
 
 
 
  '_______________________________________________________________________________________________________
  'Code - Timer Benchmark
    BenchMark = Timer
    
 
 '_______________________________________________________________________________________________________
  'Code - set sheet names
    
    Sht1 = "Sheet1"
    Sht2 = "Sheet2"


    
  '_______________________________________________________________________________________________________
  'Code -
    
    NLR_Sht2 = LastRowF(Sht2)
    
    With Sheets(Sht2)
        .Range("C" & NLR_Sht2).Clear
    End With



  '_______________________________________________________________________________________________________
  'Code -

    With Sheets(Sht1)
        Set Rng_Sht1_DS1 = .Range(.Cells(9, 1), .Cells(24, 1))
        Set Rng_Sht1_DS2 = .Range(.Cells(9, 2), .Cells(32, 2))
    End With
    
    

  '_______________________________________________________________________________________________________
  'Code -
  
    NoSL = 9 'starting row for the loop
    NLR_Sht2 = LastRowF(Sht2) 'last row for the loop
    
    With Sheets(Sht2)
     
     For j = 1 To 2
        
        If j = 1 Then
            Set Rng = Rng_Sht1_DS1
            DataSet = "DATA SET 1"
        ElseIf j = 2 Then
            Set Rng = Rng_Sht1_DS2
            DataSet = "DATA SET 2"
        End If
        
        NoSL = 9
        
        For Each aCell In Rng
        
            For i = NoSL To NLR_Sht2
                DateStart = .Cells(i, 1)
                DateEnd = .Cells(i, 2)
                CommentStr = .Cells(i, 3)
                
                'Check if date is within start and end dates
                 If Not IsEmpty(DateStart) And aCell < DateStart Then
                    Exit For
                 ElseIf Not IsEmpty(DateStart) And aCell >= DateStart And aCell <= DateEnd Then
                       
                    'Add the comment, but preserve prior comments
                     If CommentStr <> "" Then
                        CommentStr = CommentStr & " & " & DataSet & ": " & Format(aCell.Value, "YYYY-MM-DD, DDD")
                        .Cells(i, 3) = CommentStr
                     Else
                        CommentStr = DataSet & ": " & Format(aCell.Value, "YYYY-MM-DD, DDD")
                        .Cells(i, 3) = CommentStr
                     End If
                    
                     NoSL = i
                     Exit For
                    
                End If
                
            Next i
            
        Next aCell
        
     Next j
     
    End With
    
    
    
  '_______________________________________________________________________________________________________
  'Place cursor in Workbook, Sheet, and Cell
 
 
 
  '_______________________________________________________________________________________________________
  'Turn on alerts and screen updates, and calculate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Calculate


 
  '_______________________________________________________________________________________________________
  'Timer
  
    MsgBox Round(Timer - BenchMark, 2)



  '_______________________________________________________________________________________________________
  'End of the subroutine/macro
 

End Sub

"Sheet1"

Test Date Pull.xlsx

A

B

8

DATE SET 1

DATE SET 2

9

2021-01-26, Tue

2021-01-13, Wed

10

2021-03-16, Tue

2021-02-10, Wed

11

2021-04-27, Tue

2021-03-16, Tue

12

2021-06-15, Tue

2021-04-13, Tue

13

2021-07-27, Tue

2021-05-12, Wed

14

2021-09-21, Tue

2021-06-10, Thu

15

2021-11-02, Tue

2021-07-13, Tue

16

2021-12-14, Tue

2021-08-11, Wed

17

2022-01-25, Tue

2021-09-14, Tue

18

2022-03-15, Tue

2021-10-13, Wed

19

2022-05-03, Tue

2021-11-10, Wed

20

2022-06-14, Tue

2021-12-10, Fri

21

2022-07-26, Tue

2022-01-12, Wed

22

2022-09-20, Tue

2022-02-10, Thu

23

2022-11-01, Tue

2022-03-10, Thu

24

2022-12-13, Tue

2022-04-12, Tue

25

2022-05-11, Wed

26

2022-06-10, Fri

27

2022-07-13, Wed

28

2022-08-10, Wed

29

2022-09-13, Tue

30

2022-10-13, Thu

31

2022-11-10, Thu

32

2022-12-13, Tue

Sheet1

"Sheet2" before running the code

Test Date Pull.xlsx

A

B

C

8

DATE

COMMENT

9

2021-03-08, Mon

2021-03-12, Fri

10

2021-03-15, Mon

2021-03-19, Fri

11

2021-03-22, Mon

2021-03-26, Fri

12

13

2021-06-07, Mon

2021-06-11, Fri

14

2021-06-14, Mon

2021-06-18, Fri

15

2021-06-21, Mon

2021-06-25, Fri

16

17

2021-09-07, Tue

2021-09-10, Fri

18

2021-09-13, Mon

2021-09-17, Fri

19

2021-09-20, Mon

2021-09-24, Fri

20

21

2021-12-06, Mon

2021-12-10, Fri

22

2021-12-13, Mon

2021-12-17, Fri

23

2021-12-20, Mon

2021-12-23, Thu

24

25

2022-03-07, Mon

2022-03-11, Fri

26

2022-03-14, Mon

2022-03-18, Fri

27

2022-03-21, Mon

2022-03-25, Fri

28

29

2022-06-06, Mon

2022-06-10, Fri

30

2022-06-13, Mon

2022-06-17, Fri

31

2022-06-21, Tue

2022-06-24, Fri

32

33

2022-09-06, Tue

2022-09-09, Fri

34

2022-09-12, Mon

2022-09-16, Fri

35

2022-09-19, Mon

2022-09-23, Fri

Sheet2

"Sheet2" after running the code

Test Date Pull.xlsx

A

B

C

8

DATE

COMMENT

9

2021-03-08, Mon

2021-03-12, Fri

10

2021-03-15, Mon

2021-03-19, Fri

DATA SET 1: 2021-03-16, Tue & DATA SET 2: 2021-03-16, Tue

11

2021-03-22, Mon

2021-03-26, Fri

12

13

2021-06-07, Mon

2021-06-11, Fri

DATA SET 2: 2021-06-10, Thu

14

2021-06-14, Mon

2021-06-18, Fri

DATA SET 1: 2021-06-15, Tue

15

2021-06-21, Mon

2021-06-25, Fri

16

17

2021-09-07, Tue

2021-09-10, Fri

18

2021-09-13, Mon

2021-09-17, Fri

DATA SET 2: 2021-09-14, Tue

19

2021-09-20, Mon

2021-09-24, Fri

DATA SET 1: 2021-09-21, Tue

20

21

2021-12-06, Mon

2021-12-10, Fri

DATA SET 2: 2021-12-10, Fri

22

2021-12-13, Mon

2021-12-17, Fri

DATA SET 1: 2021-12-14, Tue

23

2021-12-20, Mon

2021-12-23, Thu

24

25

2022-03-07, Mon

2022-03-11, Fri

DATA SET 2: 2022-03-10, Thu

26

2022-03-14, Mon

2022-03-18, Fri

DATA SET 1: 2022-03-15, Tue

27

2022-03-21, Mon

2022-03-25, Fri

28

29

2022-06-06, Mon

2022-06-10, Fri

DATA SET 2: 2022-06-10, Fri

30

2022-06-13, Mon

2022-06-17, Fri

DATA SET 1: 2022-06-14, Tue

31

2022-06-21, Tue

2022-06-24, Fri

32

33

2022-09-06, Tue

2022-09-09, Fri

34

2022-09-12, Mon

2022-09-16, Fri

DATA SET 2: 2022-09-13, Tue

35

2022-09-19, Mon

2022-09-23, Fri

DATA SET 1: 2022-09-20, Tue

Sheet2

OaklandJim · Sep 19, 2022

Here is what I came up with. Best, probably not. But it does what you asked for.

VBA Code:

Sub DateWithinDatesComment()

'   Range object used for datasets 1 & 2
    Dim rDataSet As Range
    
'   Range points to start date cells
    Dim rStartDates As Range
    
'   Count of data cells in the range.
    Dim iDataCells As Long
    
'   Two range objects used for looping ranges
    Dim rCellDataSet As Range
    Dim rCellDateCheck As Range
    
'   Three date values: date to test, start and end dates
    Dim dTestDate As Date
    Dim dStartDate As Date
    Dim dEndDate As Date
    
'   Used to copy comments from dataset one. If there is a dataset
'   two entry then need to preserve the dataset 1 comment.
    Dim sCommentDataSet1 As String
    
'   Range where start dates reside.
    With Worksheets("Sheet2")
        iDataCells = Application.WorksheetFunction.CountA(.Columns(2)) - 1
        Set rStartDates = .Range("A1").Offset(1).Resize(iDataCells)
    End With
    
'   Range containing dataset 1.
    With Worksheets("Sheet1")
        iDataCells = Application.WorksheetFunction.CountA(.Columns(1)) - 1
        Set rDataSet = .Range("A1").Offset(1).Resize(iDataCells)
    End With

'   Clear existing comments -- offset two columns from start dates.
    rStartDates.Cells(1).Offset(1, 2).Resize(iDataCells).Value = ""

'   Process dataset 1.
    For Each rCellDataSet In rDataSet
    
        dTestDate = CDate(rCellDataSet.Value)
        
        For Each rCellDateCheck In rStartDates
            dStartDate = CDate(rCellDateCheck.Value)
            dEndDate = CDate(rCellDateCheck.Offset(, 1).Value)
           
            If dTestDate >= dStartDate And dTestDate <= dEndDate _
             Then
                rCellDateCheck.Offset(, 2).Value = "Dataset 1, " & Format(dTestDate, "m/d/yyyy, ddd")
            End If
            
        Next rCellDateCheck
    
    Next rCellDataSet

'   Range for dataset 2.
    With Worksheets("Sheet1")
        iDataCells = Application.WorksheetFunction.CountA(.Columns(2)) - 1
        Set rDataSet = .Range("B1").Offset(1).Resize(iDataCells)
    End With

'   Process dataset 2
    For Each rCellDataSet In rDataSet
    
        dTestDate = CDate(rCellDataSet.Value)
        
        For Each rCellDateCheck In rStartDates
            dStartDate = CDate(rCellDateCheck.Value)
            dEndDate = CDate(rCellDateCheck.Offset(, 1).Value)
           
            If dTestDate >= dStartDate And dTestDate <= dEndDate _
             Then
             
'               Preserve dataset 1 comment.
                sCommentDataSet1 = rCellDateCheck.Offset(, 2).Value

'               If there is a dataset 1 comment then ad ampersand to the end
'               in preparation for add dataset 2 comment.
                If sCommentDataSet1 <> "" Then sCommentDataSet1 = sCommentDataSet1 & " & "
                
'               Put comment into the comment cell. Two columns over from the start dates column.
                rCellDateCheck.Offset(, 2).Value = sCommentDataSet1 & "Dataset 2, " & Format(dTestDate, "m/d/yyyy, ddd")
            
            End If
            
        Next rCellDateCheck
    
    Next rCellDataSet

End Sub

OilEconomist · Sep 19, 2022

OaklandJim said:

Here is what I came up with. Best, probably not. But it does what you asked for.

VBA Code:

Sub DateWithinDatesComment()

'   Range object used for datasets 1 & 2
    Dim rDataSet As Range
   
'   Range points to start date cells
    Dim rStartDates As Range
   
'   Count of data cells in the range.
    Dim iDataCells As Long
   
'   Two range objects used for looping ranges
    Dim rCellDataSet As Range
    Dim rCellDateCheck As Range
   
'   Three date values: date to test, start and end dates
    Dim dTestDate As Date
    Dim dStartDate As Date
    Dim dEndDate As Date
   
'   Used to copy comments from dataset one. If there is a dataset
'   two entry then need to preserve the dataset 1 comment.
    Dim sCommentDataSet1 As String
   
'   Range where start dates reside.
    With Worksheets("Sheet2")
        iDataCells = Application.WorksheetFunction.CountA(.Columns(2)) - 1
        Set rStartDates = .Range("A1").Offset(1).Resize(iDataCells)
    End With
   
'   Range containing dataset 1.
    With Worksheets("Sheet1")
        iDataCells = Application.WorksheetFunction.CountA(.Columns(1)) - 1
        Set rDataSet = .Range("A1").Offset(1).Resize(iDataCells)
    End With

'   Clear existing comments -- offset two columns from start dates.
    rStartDates.Cells(1).Offset(1, 2).Resize(iDataCells).Value = ""

'   Process dataset 1.
    For Each rCellDataSet In rDataSet
   
        dTestDate = CDate(rCellDataSet.Value)
       
        For Each rCellDateCheck In rStartDates
            dStartDate = CDate(rCellDateCheck.Value)
            dEndDate = CDate(rCellDateCheck.Offset(, 1).Value)
          
            If dTestDate >= dStartDate And dTestDate <= dEndDate _
             Then
                rCellDateCheck.Offset(, 2).Value = "Dataset 1, " & Format(dTestDate, "m/d/yyyy, ddd")
            End If
           
        Next rCellDateCheck
   
    Next rCellDataSet

'   Range for dataset 2.
    With Worksheets("Sheet1")
        iDataCells = Application.WorksheetFunction.CountA(.Columns(2)) - 1
        Set rDataSet = .Range("B1").Offset(1).Resize(iDataCells)
    End With

'   Process dataset 2
    For Each rCellDataSet In rDataSet
   
        dTestDate = CDate(rCellDataSet.Value)
       
        For Each rCellDateCheck In rStartDates
            dStartDate = CDate(rCellDateCheck.Value)
            dEndDate = CDate(rCellDateCheck.Offset(, 1).Value)
          
            If dTestDate >= dStartDate And dTestDate <= dEndDate _
             Then
            
'               Preserve dataset 1 comment.
                sCommentDataSet1 = rCellDateCheck.Offset(, 2).Value

'               If there is a dataset 1 comment then ad ampersand to the end
'               in preparation for add dataset 2 comment.
                If sCommentDataSet1 <> "" Then sCommentDataSet1 = sCommentDataSet1 & " & "
               
'               Put comment into the comment cell. Two columns over from the start dates column.
                rCellDateCheck.Offset(, 2).Value = sCommentDataSet1 & "Dataset 2, " & Format(dTestDate, "m/d/yyyy, ddd")
           
            End If
           
        Next rCellDateCheck
   
    Next rCellDataSet

End Sub

Thanks so much for this. It shows me some alternative programming methods that I intend to use.

I tested it and it works. I compared run times and my code came a bit faster, but nothing noticeable. Check the beginning of my code and end to see how do to it if you are not familiar with it.
If you can post your code with the following changes and check to make sure it gives the same as my data set, I will then mark it as the solution.
(1) The data in both "Sheet1" and "Sheet2" starts in row 9 with row 8 as the heading. I think you start in either row 1 or 2. Can you update this.
(2) If the cells are blank, don't do anything in those rows. Right now, it is putting values in the comments section.

These two I would not ask you to change, but if you are going to change the aforementioned, will you also change this. This will allow a user to compare my output to what you get running your code and to quickly see that it gives the exact output.
(2) Change the date formatting to "YYYY-MM-DD, DDD".
(3) Change "Data Set 1" and "Data Set 2" to "DATA SET 1: " and "DATA SET 2: " respectively.

bebo021999 · Sep 20, 2022

This code works with variable array not with cells in worksheet, it might help code faster

VBA Code:

Option Explicit
Sub DateRangeCheck()
Dim lr&, i&, j&, rng1, rng2
Dim set1 As String

'store date value of sheet 1 in variable
With Sheets("Sheet1")
    lr = .UsedRange.Rows.Count + 7
    rng1 = .Range("A9:B" & lr).Value2
End With

'store date value of sheet 2 in variable
With Sheets("Sheet2")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng2 = .Range("A9:C" & lr).Value2
    
    'loop through each row of sheet2
    For i = 1 To UBound(rng2)
        If rng2(i, 1) <> "" And rng2(i, 2) <> "" Then
            set1 = "" ' set1: to store text string combination
            For j = 1 To UBound(rng1)
                       
                'check date range of data set 1 then write into set1
                If rng1(j, 1) <> "" And rng1(j, 1) >= rng2(i, 1) And rng1(j, 1) <= rng2(i, 2) Then
                    set1 = IIf(set1 = "", "DATA SET 1: ", ", " & set1 & "& ") & Format(rng1(j, 1), "yyyy-mm-dd, ddd")
                End If
                
                'check date range of data set 2 then combine into set1
                If rng1(j, 2) <> "" And rng1(j, 2) >= rng2(i, 1) And rng1(j, 2) <= rng2(i, 2) Then
                    set1 = set1 & IIf(set1 = "", "", " & ") & "DATA SET 2: " & Format(rng1(j, 2), "yyyy-mm-dd, ddd")
                End If
            Next
                  
        'write text string into variable, column 3
            rng2(i, 3) = set1 ' & set2
        End If
    Next
    .Range("A9:C" & lr).Value = rng2 ' paste variable back to sheet
End With
End Sub

MS Excel VBA Code - Simplest Way to Check if a Series of Dates is Between Two Dates and Enter Comment and Date in another Column

OilEconomist

Active Member

Excel Facts

OaklandJim

Well-known Member

OilEconomist

Active Member

bebo021999

Well-known Member

Similar threads

Forum statistics

Share this page

MS Excel VBA Code - Simplest Way to Check if a Series of Dates is Between Two Dates and Enter Comment and Date in another Column

OilEconomist

Active Member

Excel Facts

OaklandJim

Well-known Member

OilEconomist

Active Member

bebo021999

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock