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

[NimishK]

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	B	C	D	E	F	G
1	abcd	01-01-2019	300	02-01-2019	400	03-01-2019	500
2	xyz	03-01-2019	200	03-01-2019	100	05-01-2019	150
3	lmnp	04-01-2019	100	06-01-2019	600	07-01-2019	700
4	excl	08-01-2019	150	08-01-2019	0	08-01-2019	250
5	dfert	07-01-2019	300	09-01-2019	400	10-01-2019	200

<tbody>
</tbody>

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

 

[oldbrewer]

red

02/04/2019

4.37

1 2

row 1

01/01/2000

01/01/2030

01/04/2019

green

taxi

2 1

blue

999

03/04/2019

3 3

col G

formula in G1

=IF(AND(A1>$R$1,A1<$S$1),ROW(A1)&" "&COLUMN(A1),"")

so you have row and column number for each date in A1:C3

if you want column number as a letter use a lookup table like

1

A

2

B

3

C

4

D

5

E

<colgroup><col span="3"><col span="9"><col><col><col span="3"><col span="2"><col></colgroup><tbody>
</tbody>

 

[NimishK]

OldBrewer

=IF(AND(A1>$R$1,A1<$S$1),ROW(A1)&" "&COLUMN(A1),"")

copied your formula in L1 Nothing Happens. because in G1 already data exists as per post #1
by the way what does $R$1 and $S$1 mean
Difficult to understand your structure of columns and rows as per your post #2

 

[oldbrewer]

red

02/04/2019

4.37

1 2

row 1

01/01/2000

01/01/2030

01/04/2019

green

taxi

2 1

blue

999

03/04/2019

3 3

col G

formula in G1

=IF(AND(A1>$R$1,A1<$S$1),ROW(A1)&" "&COLUMN(A1),"")

so you have row and column number for each date in A1:C3

if you want column number as a letter use a lookup table like

1

A

2

B

3

C

4

D

5

E

a1 = CELL A1

$A$1 IS A FIXED REFERENCE TO a1

in b1 put =a1+7

copy to C1 and you get 15

in B1 put =$a$1+ 7 copy to C1 you get 8

<colgroup><col span="3"><col span="9"><col><col><col span="3"><col span="2"><col></colgroup><tbody>
</tbody>

 

[oldbrewer]

L1 is to give you bearings it marks column L - there is no formula

 

[NimishK]

a1 = CELL A1
$A$1 IS A FIXED REFERENCE TO a1
in b1 put =a1+7
copy to C1 and you get 15
in B1 put =$a$1+ 7 copy to C1 you get 8

$A$1 IS A FIXED REFERENCE TO a1 Yes i understand that is a fixed Referenced to A1. But you haved fixed refernce for R and S as per post #2 as I asked you what does $R$1 and $S$1 mean
My strong suggestions can you come up with the same formula using my structure in post #1 rather than your post(s) #2 and #4 .
it could clear my doubts at this point.

 

[oldbrewer]

r1 and s1 are the 2 dates 1/1/2000 and 1/1/2030

red

02/04/2019

4.37

B1

row 1

01/01/2000

01/01/2030

01/04/2019

green

taxi

A2

blue

999

03/04/2019

C3

these are bounding dates

to avoid problems with other

col G

cells being processed as dates

formula in G1

=IF(AND(A1>$R$1,A1<$S$1),VLOOKUP(COLUMN(A1),mytable,2)&ROW(A1),"")

so you have row and column number for each date in A1:C3

if you want column number as a letter use a lookup table like

1

A

this is called mytable

2

B

3

C

4

D

5

E

a1 = CELL A1

$A$1 IS A FIXED REFERENCE TO a1

in b1 put =a1+7

copy to C1 and you get 15

in B1 put =$a$1+ 7 copy to C1 you get 8

NOTE IT NOW GIVES "NORMAL" CELL REFERENCES

<colgroup><col span="3"><col span="9"><col><col><col span="3"><col span="2"><col></colgroup><tbody>
</tbody>

 

[NimishK]

Thanks OldBrewer for your efforts. I Thought i could move on with your suggestion and try to implement with VBA code but it seems with your input. I will not be able to link with my VBA code as per #1 .


The following is desired result

	A	B	C	D	E
Header Row /Row nos below	Values of Col A from Sheet1	values Dates from Sheet1 i.e values of K as per code Post#1	Values of cols C, E, & G from sheet1	Rows Nos ie values of P as per code Post#1	Cell Address of dates in sheet1
2	abcd	01-01-2019	300	2	B2
3	abcd	02-01-2019	400	2	D1
4	abcd	03-01-2019	500	2	F1
5	xyz	03-01-2019	200	3	B3
6	xyz	03-01-2019	100	3	D3
7	lmnp	04-01-2019	100	4	B4
8	XYZ	05-01-2019	150	3	F3
9	lmnp	06-01-2019	600	4	D4
10	lmnp	07-01-2019	700	4	F4
11	dfert	07-01-2019	300	6	B6
12	excl	08-01-2019	150	5	B5
13	excl	08-01-2019	0	5	D5
14	excl	08-01-2019	250	5	D5
15	dfert	09-01-2019	400	6	D6
16	dfert	10-01-2019	200	6	F6

<tbody>
</tbody>

 

[DanteAmor]

Try this

Sub get_cell_Address()
 Dim o As Worksheet, d As Worksheet, n As Long
 Set o = Sheets("Sheet1")    'origen
 Set d = Sheets("Sheet2")    'destination
 d.Rows("2:" & Rows.Count).ClearContents
 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
End Sub

 

[NimishK]

DanteAmor thanks

First of all Error generated as variables j and i were not defined
So I dimmed as Long for both the variables. Hope that should not be an issue
and below is the Result as per coding
Col C getting Date values rather then Dates and from row 17 data not required

2	abcd	43466	300	2	B2
3	abcd	43467	400	2	D2
4	abcd	43468	500	2	F2
5	xyz	43468	200	3	B3
6	xyz	43468	100	3	D3
7	lmnp	43469	100	4	B4
8	xyz	43470	150	3	F3
9	lmnp	43471	600	4	D4
10	dfert	43472	300	6	B6
11	lmnp	43472	700	4	F4
12	excl	43473	150	5	B5
13	excl	43473	0	5	D5
14	excl	43473	250	5	F5
15	dfert	43474	400	6	D6
16	dfert	43475	200	6	F6
17	abcd			2	L2
18	abcd			2	H2
19	abcd			2	J2
20	dfert			6	H6
21	dfert			6	J6
22	dfert			6	L6
23	excl			5	H5
24	excl			5	J5
25	excl			5	L5
26	lmnp			4	H4
27	lmnp			4	J4
28	lmnp			4	L4
29	xyz			3	H3
30	xyz			3	J3
31	xyz			3	L3

<tbody>
</tbody>