To get cell Address value of Each Date displayed in a Range

N

NimishK

Well-known Member
Joined
Sep 4, 2015
Messages
684
Hi,
Any ideas how can i get cell address values of EACH dates which are displayed in a range which are in Sheet1
Structure of sheet1
A BC DE FG
1abcd01-01-201930002-01-201940003-01-2019500
2xyz03-01-201920003-01-201910005-01-2019150
3lmnp04-01-201910006-01-201960007-01-2019700
4excl08-01-201915008-01-2019008-01-2019250
5dfert07-01-201930009-01-201940010-01-2019200

<tbody>
</tbody>

Code: 
Sub GetCellAddressofDates()
Dim Dn As Range, rng As Range, Col As Variant
Dim nRng As Range
Dim Dic As Object, Dt As Variant
Dim Q
  Col = Array(2, 4, 6) 
   With Sheets("Sheet1")
    Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    Set Dic = CreateObject("Scripting.Dictionary")   
        Dic.CompareMode = 1   
  For Each Dt In Col
    Set rng = Range(Cells(1, Dt), Cells(Rows.Count, Dt).End(xlUp))
        For Each Dn In rng
            If Not Dic.exists(Dn.Value) Then
                Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            End If
        
        If Not Dic(Dn.Value).exists(Dn.Row) Then
                Dic(Dn.Value).Add (Dn.Row), Nothing
        End If


    Next Dn
   Next Dt
   
   Dim k As Variant, nDt As Date, Ldt As Date, p As Variant, c As Long


   c = 1
   With Sheets("Sheet2")
    If txtFromDate.Value <> "" And txtToDate.Value <> "" Then
   
    For Each k In Dic.Keys
     If Dic.exists(CDate(txtFromDate.Value)) And Dic.exists(CDate(txtToDate.Value)) Then
        If k >= CDate(txtFromDate.Value) And k <= CDate(txtToDate.Value) Then
          For Each p In Dic(k)
               c = c + 1
               .Cells(c, "A") = k   
               .Cells(c, "B") = p   
                .Cells(c, "C") = [COLOR=#ff0000][B]'to get cell address of value K which is in Sheet1
[/B][/COLOR]           Next p
        End If
        ElseIf Dic.exists(CDate(txtFromDate.Text)) Then
            If k >= CDate(txtFromDate.Text) Then
                For Each p In Dic(k)
                    c = c + 1
                    .Cells(c, "a") = k  
                    .Cells(c, "b") = p  
                    .Cells(c, "C") = [COLOR=#ff0000][B]'to get cell address of value K[/B]
[/COLOR]                Next p
            End If
        End If
 
Next k
[Structre and code adopted from MrExcel - thread 1088850]
Thanks
NimishK
 
Last edited:
Sort by date Sort by votes
Dim i as long, dim j as long ' is correct

Before executing the macro you have to put on Sheet2 in the column C the date format.

My results go to row 16.


Surely you have cells with blank spaces in your sheet1 below the last cell in column A. Delete those cells and execute the macro again.
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Surely you have cells with blank spaces in your sheet1 below the last cell in column A. Delete those cells and execute the macro again.
Click to expand...
Infact i deleted full blank rows after the last cell in col A but values from row 17 are repeated as post #10 . Tried your code 7-10 times. Really Nothing Happened.
Will it be possible to control blank spaces so that values from row 17 are not repeated
 
Last edited:
Upvote 0
I do not know how you have the data, it works for me until the 16th. it is possible to review the blanks with the macro, but the macros will always have their limitations, such as protected sheets, hidden sheets, sheets with tables, filtered data, hidden columns, cell formats, merged cells, etc. I suggest you try the macro in a new book only with the example data that you put, since I can not see how your data is and solve each situation described above.
 
Upvote 0
Hi Yes You were absolutely right i had to delete other sub-routines and subroutine as per #1 to check your valuable suggestion. Worked Perfectly
But was wondering as per #post 1 there are two textboxes txtFromDate.text and txtToDate.Text where the dates entered and those dates are displayed.
Any possibility with your suggestion how to get the cell address of each From date uptill To Date


File attached
https://www.dropbox.com/s/ngn89toysu97vi8/DateMis-Nim.xlsm?dl=0
 
Upvote 0
I'm not sure what you want to do with the dates.
Do you want to filter by dates?
Or do you want to mark the range from txtFromDate to txtToDate?



Important: The particular search of a date, using the find method, requires that the format of the date in the cell be dd / mm / yyyy.

Try the following on my file:

Code: 
Option Explicit
Dim fromDate As Date, toDate As Date

Private Sub UserForm_Initialize()
Load UserForm1
UserForm1.Show vbModeless
End Sub

Private Sub txtFromDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtFromDate.Value = vbNullString Then
    Exit Sub
ElseIf Not IsDate(txtFromDate.Value) Then
    Cancel = True
    MsgBox "Invalid date, please re-enter", vbCritical

    txtFromDate.Value = vbNullString
    txtFromDate.SetFocus
    Exit Sub
End If
fromDate = DateSerial(Year(Date), Month(Date), Day(Date))
[COLOR=#ff0000]txtFromDate.Value = Format(CDate(txtFromDate.Value), "dd/mm/yyyy")[/COLOR]

End Sub

Private Sub txtToDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtToDate.Value = vbNullString Then
    Exit Sub
ElseIf Not IsDate(txtToDate.Value) Then
    Cancel = True
    MsgBox "Invalid date, please re-enter", vbCritical

    txtToDate.Value = vbNullString
    txtToDate.SetFocus
    Exit Sub
End If
toDate = DateSerial(Year(Date), Month(Date), Day(Date))
[COLOR=#ff0000]txtToDate.Value = Format(CDate(txtToDate.Value), "dd/mm/yyyy")[/COLOR]

End Sub
Private Sub cmdAllInputDates_Click()
   Call get_cell_Address
End Sub

Sub get_cell_Address()
     'DanteAmor https://www.mrexcel.com/forum/excel-questions/1095288-get-cell-address-value-each-date-displayed-range.html
     Dim o As Worksheet, d As Worksheet, n As Long, j As Long, i As Long
     Dim b As Range, c As Range
     
     Application.ScreenUpdating = False
     Set o = Sheets("Sheet1")    'origen
     Set d = Sheets("Sheet2")    'destination
[COLOR=#ff0000]     d.Columns("C").NumberFormat = "dd/mm/yyyy"[/COLOR]
     d.Rows("2:" & Rows.Count).ClearContents
     d.Columns("F").Interior.ColorIndex = xlNone
     n = 2
     For j = 2 To o.Cells(2, Columns.Count).End(xlToLeft).Column Step 2
      For i = 2 To o.Cells(Rows.Count, 1).End(xlUp).Row
       d.Cells(n, "A").Resize(, 6) = Array(n, o.Cells(i, 1), o.Cells(i, j), o.Cells(i, j).Offset(, 1), i, o.Cells(i, j).Address(0, 0))
       n = n + 1
      Next
     Next
     d.Range("B2:F2").Resize(n).Sort key1:=d.Range("C2"), order1:=xlAscending, key2:=d.Range("b2"), order2:=xlAscending, Header:=xlNo
        If txtFromDate <> "" And IsDate(txtFromDate) Then
            If txtToDate <> "" And IsDate(txtToDate) Then
                Set b = d.Range("C:C").Find(txtFromDate, LookIn:=xlValues, lookat:=xlWhole)
                Set c = d.Range("C:C").Find(txtToDate, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
                If Not b Is Nothing Then
                    If Not c Is Nothing Then
                        d.Range(d.Cells(b.Row, "F"), d.Cells(c.Row, "F")).Interior.ColorIndex = 6
                        End If
                End If
            End If
        End If
 End Sub

https://www.dropbox.com/s/utjr3eotnvk8mog/DateMis-Nim dam.xlsm?dl=0
 
Last edited:
Upvote 0
DanteAmor Thankx
Yes, it is Filtering of dates
i.e to get the list of Dates or display the range of date in destination sheet between fromDate and to Date
As per your eg you have directly put dates 03-01-2019 in txtFromdate .text and 08-01-2019 in txtToDate.text in uf
So in that case it should display in following though you have hilited in F col with color index
4abcd03-01-20195002F2
5xyz03-01-20192003B3
6xyz03-01-20191003D3
7lmnp04-01-20191004B4
8xyz05-01-20191503F3
9Lmnp06-01-20196004D4
10Dfert07-01-20193006B6
11Lmnp07-01-20197004F4
12Excl08-01-20191505B5
13Excl08-01-201905D5
14Excl08-01-20192505F5

<tbody>
</tbody>
Click to expand...

In other words if txtFromdate .text ‘s input is 01-01-2019 and txttodate .text ‘s input is 05-01-2019
Then to display
2abcd01-01-20193002B2
3abcd02-01-20194002D2
4abcd03-01-20195002F2
5xyz03-01-20192003B3
6xyz03-01-20191003D3
7lmnp04-01-20191004B4
8xyz05-01-20191503F3

<tbody>
</tbody>
Click to expand...
Important: The particular search of a date, using the find method, requires that the format of the date in the cell be dd / mm / yyyy.
Click to expand...

can't the above be as dd-mmm-yyyy
 
Last edited:
Upvote 0
Try this, and of course, it can be dd-mmm-yyyy


Code: 
Option Explicit
Dim fromDate As Date, toDate As Date


Private Sub UserForm_Initialize()
Load UserForm1
UserForm1.Show vbModeless
End Sub


Private Sub txtFromDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtFromDate.Value = vbNullString Then
    Exit Sub
ElseIf Not IsDate(txtFromDate.Value) Then
    Cancel = True
    MsgBox "Invalid date, please re-enter", vbCritical


    txtFromDate.Value = vbNullString
    txtFromDate.SetFocus
    Exit Sub
End If
fromDate = DateSerial(Year(Date), Month(Date), Day(Date))
txtFromDate.Value = Format(CDate(txtFromDate.Value), "[COLOR=#0000cd]dd-mm-yyyy[/COLOR]")


End Sub
Private Sub txtToDate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtToDate.Value = vbNullString Then
    Exit Sub
ElseIf Not IsDate(txtToDate.Value) Then
    Cancel = True
    MsgBox "Invalid date, please re-enter", vbCritical


    txtToDate.Value = vbNullString
    txtToDate.SetFocus
    Exit Sub
End If
toDate = DateSerial(Year(Date), Month(Date), Day(Date))
txtToDate.Value = Format(CDate(txtToDate.Value), "[COLOR=#0000cd]dd-mm-yyyy[/COLOR]")


End Sub
Private Sub cmdAllInputDates_Click()
   Call get_cell_Address
End Sub


Sub get_cell_Address()
     'DanteAmor https://www.mrexcel.com/forum/excel-questions/1095288-get-cell-address-value-each-date-displayed-range.html
     Dim o As Worksheet, d As Worksheet, n As Long, j As Long, i As Long
     Dim b As Range, c As Range
     
     Application.ScreenUpdating = False
     Set o = Sheets("Sheet1")    'origen
     Set d = Sheets("Sheet2")    'destination
     d.Columns("C").NumberFormat = "[COLOR=#0000cd]dd-mmm-yyyy[/COLOR]"
     d.Rows("2:" & Rows.Count).ClearContents
     d.Columns("F").Interior.ColorIndex = xlNone
     n = 2
     For j = 2 To o.Cells(2, Columns.Count).End(xlToLeft).Column Step 2
      For i = 2 To o.Cells(Rows.Count, 1).End(xlUp).Row
       d.Cells(n, "A").Resize(, 6) = Array(n, o.Cells(i, 1), o.Cells(i, j), o.Cells(i, j).Offset(, 1), i, o.Cells(i, j).Address(0, 0))
       n = n + 1
      Next
     Next
     d.Range("B2:F2").Resize(n).Sort key1:=d.Range("C2"), order1:=xlAscending, key2:=d.Range("b2"), order2:=xlAscending, Header:=xlNo
     
     Dim lr As Long
     lr = d.Range("A" & Rows.Count).End(xlUp).Row
     For i = lr To 2 Step -1
        If d.Cells(i, "C").Value >= CDate(txtFromDate.Value) And _
           d.Cells(i, "C").Value <= CDate(txtToDate.Value) Then
        Else
            d.Rows(i).Delete
        End If
    Next
End Sub
 
Upvote 0
Just Perfect.:)(y)
Thanks DanteAmor for your very quick response and spending your valuable time for this solution.
Also Congrats for posting more than 2400 posts in just span of 5 months.
Thank you so much
NimishK
 
Upvote 0
NimishK said:
Just Perfect.:)(y)
Thanks DanteAmor for your very quick response and spending your valuable time for this solution.
Also Congrats for posting more than 2400 posts in just span of 5 months.
Thank you so much
NimishK
Click to expand...

I'm glad to help you. I appreciate your kind comments.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
extract date but exclude Time
Replies
2
Views
281
rikvny02
R
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
348
Agnarr
Agnarr
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
223
B-radK
B
montecarlo2012
  • Solved
vba=Loop through each row in the data range.(B2:F10000)
Replies
9
Views
2K
montecarlo2012
montecarlo2012
SaraWitch
  • Solved
Extract individual lines from cell
Replies
6
Views
239
SaraWitch
SaraWitch

Forum statistics

Threads
1,214,985
Messages
6,122,602
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top