1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Find today between 2 dates in column A & B

Discussion in 'VBA Macros' started by Belleke, Nov 8, 2018.

  1. Belleke

    Belleke Active Member

    Column A =
    Column B=
    So today is between these 2 dates then application goto should go to that row and color row in A & B blue.

    thanks in advance
  2. Kenneth Hobson

    Kenneth Hobson Active Member

    Code (vb):
    Sub Main()
    Dim d1 As Date, d2 As Date, d3 As Date
    Dim f1 As Range, f2 As Range, f3 As Range
    d1 = #5/11/2018#
    d2 = #11/11/2018#
    d3 = Date
    On Error GoTo TheEnd
    Set f1 = Columns("A:B").Find(d1)
    Set f2 = Columns("A:B").Find(d2)
    Set f3 = Range(f1, f2).Find(d3)
    Range(Cells(f3.Row, "A"), Cells(f3.Row, "B")).Interior.Color = vbBlue
    Application.Goto f3
    End Sub
    Belleke likes this.
  3. Belleke

    Belleke Active Member

    Hi Kenneth,
    Thanks for the reply.
    It is not exactly what I mean,d1 and d2 should be dynamic because Column A and B are full of dates.
    See example

    Attached Files:

  4. chirayu

    chirayu Well-Known Member

    Code (vb):
    Sub ColorMe()

    Dim Rng As Range
    Dim SubRng As Range

    Set Rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

    For Each SubRng In Rng

        If Date >= SubRng And Date <= SubRng.Offset(0, 1) Then
            Range(SubRng, SubRng.Offset(0, 1)).Interior.Color = RGB(255, 0, 0)
        End If

    Next SubRng

    End Sub
    Belleke likes this.
  5. Belleke

    Belleke Active Member

    Hi Chirayu,
    Thanks for your effort.
    I solved it this way
    Code (vb):
    Private Sub CommandButton1_Click()
    ActiveSheet.ListObjects("Tabel1").Range.AutoFilter Field:=1, Criteria1:= _
            xlFilterThisWeek, Operator:=xlFilterDynamic
    End Sub
    Kenneth & Chirayu, thanks.

Share This Page