Scripting Dictionay vba for matching start date and end date range between 2 sheets for each id

Status
Not open for further replies.

motherindia

Board Regular
Joined
Oct 15, 2015
Messages
218
Dear All,

I need VBA code for comparing start date and end date range between 2 sheets for each id
to compare ID , start date and end date of sheet 1 with sheet and copy missing date in separate sheet.
following is the example shown which is what i need. I VBA code as the data is 40k-to 50k comparison.

please help me out.



Sheet1
ID St date End date
1 01-04-2015 03-04-2015
1 04-04-2015 07-04-2015
2 06-04-2015 15-04-2015



Sheet2
ID St date End date
1 01-04-2015 10-04-2015
2 01-04-2015 03-04-2015
2 04-04-2015 07-04-2015
2 09-04-2015 13-04-2015

Output on separate sheet

ID Date Missing Remarks
1 08-04-2015 Not in Sheet1
1 09-04-2015 Not in Sheet1
1 10-04-2015 Not in Sheet1
2 08-04-2015 Not in Sheet2
2 14-04-2015 Not in Sheet2
2 15-04-2015 Not in Sheet2



Regards,
Motherindia
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Try this:-
Results sheet3 starting "A1"
Code:
[COLOR="Navy"]Sub[/COLOR] MG07Nov29
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sht [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dt [COLOR="Navy"]As[/COLOR] Date
[COLOR="Navy"]Dim[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
   [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
Sht = Array("Sheet1", "Sheet2")
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sht)
    [COLOR="Navy"]With[/COLOR] Sheets(Sht(n))
        Ray = .Range("A1").CurrentRegion
    [COLOR="Navy"]End[/COLOR] With
   [COLOR="Navy"]For[/COLOR] Rw = 2 To UBound(Ray, 1)
            [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Ray(Rw, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(Rw, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]For[/COLOR] Dt = Ray(Rw, 2) To Ray(Rw, 3)
                [COLOR="Navy"]If[/COLOR] Not Dic(Ray(Rw, 1)).Exists(Dt) [COLOR="Navy"]Then[/COLOR]
                    Dic(Ray(Rw, 1)).Add (Dt), "Not in Sheet" & IIf(n = 0, 2, 1)
                    Num = Num + 1
                [COLOR="Navy"]Else[/COLOR]
                    Num = Num - 1
                    Dic(Ray(Rw, 1)).Remove (Dt)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] Dt
   [COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]Next[/COLOR] n


ReDim Ray(1 To Num + 1, 1 To 3)
Ray(1, 1) = "ID": Ray(1, 2) = "Dates missing": Ray(1, 3) = "Remarks)"
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
        c = c + 1
        Ray(c, 1) = k
        Ray(c, 2) = p
        Ray(c, 3) = Dic(k).Item(p)
    [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3").Range("A1").Resize(c, 3)
    .Value = Ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
OMG I don't know how to thank you.
thanks for quick reply and wonderful piece of code.
That works great! you are truly a great champion!

But I need one more changes in the above. I need to reconcile the sheets slightly different. Sorry to bother for the changes;
Following is the example; (0.5 means half day work)

Sheet1
ID S Date E Date Days worked
1 31-Aug-15 03-Sep-15 3.50
2 01-Sep-15 03-Sep-15 2.50
2 04-Sep-15 04-Sep-15 1.00


Sheet2
ID S Date E Date Days worked
1 31-Aug-15 31-Aug-15 0.5
1 01-Sep-15 01-Sep-15 1
1 02-Sep-15 02-Sep-15 1
1 03-Sep-15 03-Sep-15 1
1 04-Sep-15 04-Sep-15 1
2 01-Sep-15 02-Sep-15 2
2 03-Sep-15 03-Sep-15 0.5
2 04-Sep-15 04-Sep-15 0.50
Sheet3 (Result sheet)
ID S Date E Date Days worked
1 04-Sep-15 04-Sep-15 1 not in shee2
2 04-Sep-15 04-Sep-15 0.50 not in sheet1
2 04-Sep-15 04-Sep-15 1.00 not in sheet2


Regards,
Motherindia
 
Upvote 0
I'm sorry to say that at the moment I can't find a solution.
It does pose some Problems !!!!
If I get a moment I'll look at it again
Regrds Mick
 
Upvote 0
Hi Mick,

Thanks a lot for your quick responses. Please take your own time and do let me know if you find any solutions.

Regards,
Motherindia
 
Upvote 0
Once again thanks a ton Mike Sir.
I 100% agree with your examples and the results are what I expected. But when I run macro real example I get an error at the following line;

If Not Dic(Dn.Value).Exists(oDts) Then

But the error was due to the E# which is not in Data1, but it's there in Data2.
Following is the example which I got error;

Data1 (Sheet1)

ID S Date E Date Days worked
100988516 10-Jul-15 10-Jul-15 1.00
100988516 07-Jul-15 07-Jul-15 1.00
100988516 16-Jul-15 31-Jul-15 15.50
100988516 01-Aug-15 03-Aug-15 3.00
100999956 03-Aug-15 03-Aug-15 1.00
100999956 04-Aug-15 04-Aug-15 1.00
100999956 05-Aug-15 05-Aug-15 1.00
100999956 06-Aug-15 06-Aug-15 1.00
100999956 07-Aug-15 07-Aug-15 1.00
100999956 08-Aug-15 10-Aug-15 3.00
100999956 11-Aug-15 11-Aug-15 1.00
100999956 12-Aug-15 12-Aug-15 1.00
100999956 13-Aug-15 13-Aug-15 1.00
100999956 14-Aug-15 17-Aug-15 4.00
100999956 18-Aug-15 18-Aug-15 1.00
100999956 19-Aug-15 19-Aug-15 1.00
100999956 20-Aug-15 20-Aug-15 1.00
100999956 21-Aug-15 21-Aug-15 1.00
100999956 22-Aug-15 24-Aug-15 3.00
100999956 25-Aug-15 25-Aug-15 1.00
100999956 26-Aug-15 26-Aug-15 1.00
100999956 27-Aug-15 27-Aug-15 1.00
100999956 28-Aug-15 28-Aug-15 1.00
100970513 21-Aug-15 21-Aug-15 1.00
100970513 22-Aug-15 24-Aug-15 3.00
100970513 25-Aug-15 25-Aug-15 1.00
100970513 26-Aug-15 26-Aug-15 1.00
100970513 27-Aug-15 27-Aug-15 1.00
100970513 28-Aug-15 28-Aug-15 1.00
100970513 29-Aug-15 31-Aug-15 3.00
100970513 01-Sep-15 01-Sep-15 1.00
100970513 02-Sep-15 02-Sep-15 1.00
100970513 03-Sep-15 03-Sep-15 1.00
100970513 04-Sep-15 04-Sep-15 1.00
100970513 02-Jul-15 02-Jul-15 0.50
100970513 03-Jul-15 03-Jul-15 1.00
100987480 23-Jun-15 23-Jun-15 0.50
100987480 01-Jul-15 01-Jul-15 1.00
100987480 02-Jul-15 02-Jul-15 1.00
100987480 18-Jul-15 20-Jul-15 2.50
100987480 25-Jul-15 27-Jul-15 2.50

Data2 (Sheet2)

ID S Date E Date Days worked
100820087 14-Jul-15 14-Jul-15 1.00
100820087 19-Aug-15 19-Aug-15 1.00
100820859 31-Aug-15 31-Aug-15 0.50
100820859 01-Sep-15 01-Sep-15 1.00
100820859 02-Sep-15 02-Sep-15 1.00
100820859 03-Sep-15 03-Sep-15 1.00
100820859 04-Sep-15 04-Sep-15 1.00
100820859 08-Sep-15 08-Sep-15 1.00
100820859 09-Sep-15 09-Sep-15 1.00
100820859 10-Sep-15 10-Sep-15 1.00
100820859 11-Sep-15 11-Sep-15 1.00
100820859 12-Sep-15 14-Sep-15 3.00
100820859 15-Sep-15 15-Sep-15 1.00
100820859 16-Sep-15 16-Sep-15 1.00
100820859 17-Sep-15 17-Sep-15 1.00
100820859 18-Sep-15 18-Sep-15 1.00
100820859 19-Sep-15 21-Sep-15 3.00
100820859 22-Sep-15 22-Sep-15 1.00
100820859 23-Sep-15 23-Sep-15 1.00
100820859 24-Sep-15 24-Sep-15 1.00
100820859 25-Sep-15 25-Sep-15 1.00
100821359 10-Sep-15 10-Sep-15 1.00
100821359 11-Sep-15 11-Sep-15 1.00
100821359 12-Sep-15 14-Sep-15 3.00
100821359 15-Sep-15 15-Sep-15 1.00
100821359 16-Sep-15 16-Sep-15 1.00
100821359 17-Sep-15 17-Sep-15 1.00
100821359 18-Sep-15 18-Sep-15 1.00
100821359 19-Sep-15 21-Sep-15 3.00
100821359 22-Sep-15 22-Sep-15 1.00
100821359 23-Sep-15 23-Sep-15 1.00
100821417 22-Jul-15 22-Jul-15 1.00
100821417 23-Jul-15 23-Jul-15 1.00
100821417 24-Jul-15 24-Jul-15 1.00
100970513 28-Aug-14 28-Aug-14 1.00
100970513 04-Nov-14 04-Nov-14 1.00
100970513 12-Nov-14 14-Nov-14 3.00
100970513 21-Nov-14 23-Nov-14 3.00
100970513 24-Nov-14 28-Nov-14 5.00
100970513 29-Nov-14 30-Nov-14 2.00
100970513 01-Dec-14 01-Dec-14 1.00
100970513 25-Mar-15 25-Mar-15 1.00
100970513 30-Mar-15 31-Mar-15 2.00
100970513 22-Jun-15 26-Jun-15 5.00
100970513 27-Jun-15 30-Jun-15 4.00
100970513 02-Jul-15 02-Jul-15 0.50
100970513 03-Jul-15 03-Jul-15 1.00
100970513 04-Jul-15 06-Jul-15 3.00
100970513 07-Jul-15 07-Jul-15 0.50
100987480 16-Dec-14 16-Dec-14 1.00
100987480 18-Dec-14 19-Dec-14 2.00
100987480 23-Dec-14 23-Dec-14 1.00
100987480 02-Feb-15 02-Feb-15 1.00
100987480 04-Feb-15 04-Feb-15 1.00
100987480 13-Feb-15 13-Feb-15 1.00
100987480 19-Feb-15 19-Feb-15 1.00
100987480 08-Apr-15 08-Apr-15 1.00
100987480 10-Apr-15 10-Apr-15 1.00
100987480 15-Apr-15 15-Apr-15 1.00
100987480 16-Apr-15 16-Apr-15 1.00
100987480 24-Apr-15 26-Apr-15 3.00
100987480 27-Apr-15 30-Apr-15 4.00
100987480 01-May-15 05-May-15 5.00
100987480 06-May-15 06-May-15 1.00
100987480 07-May-15 07-May-15 1.00
100987480 11-May-15 11-May-15 1.00
100987480 13-May-15 13-May-15 1.00
100987480 18-May-15 18-May-15 1.00
100987480 26-May-15 26-May-15 1.00
100987480 27-May-15 27-May-15 1.00
100987480 28-May-15 28-May-15 1.00
100987480 29-May-15 29-May-15 1.00
100987480 04-Jun-15 04-Jun-15 1.00
100987480 05-Jun-15 05-Jun-15 1.00
100987480 09-Jun-15 09-Jun-15 1.00
100987480 23-Jun-15 23-Jun-15 0.50
100987480 01-Jul-15 01-Jul-15 1.00
100987480 02-Jul-15 02-Jul-15 1.00
100987480 08-Jul-15 17-Jul-15 10.00
100987480 18-Jul-15 19-Jul-15 2.00
100987480 20-Jul-15 20-Jul-15 0.50
100987480 21-Jul-15 21-Jul-15 1.00
100987480 24-Jul-15 24-Jul-15 1.00
100987480 25-Jul-15 26-Jul-15 2.00
100987480 27-Jul-15 27-Jul-15 0.50
100987480 28-Jul-15 28-Jul-15 1.00
100987480 29-Jul-15 29-Jul-15 1.00
100988516 01-Jun-15 16-Jun-15 16.00
100988516 07-Jul-15 07-Jul-15 1.00
100988516 10-Jul-15 10-Jul-15 1.00
100988516 16-Jul-15 30-Jul-15 15.00
100988516 31-Jul-15 31-Jul-15 0.50
100988516 01-Aug-15 03-Aug-15 3.00
100999956 01-Aug-15 01-Aug-15 1.00
100999956 03-Aug-15 03-Aug-15 1.00
100999956 04-Aug-15 04-Aug-15 1.00
100999956 05-Aug-15 05-Aug-15 1.00
100999956 06-Aug-15 06-Aug-15 1.00
100999956 07-Aug-15 07-Aug-15 1.00
100999956 08-Aug-15 10-Aug-15 3.00
100999956 11-Aug-15 11-Aug-15 1.00
100999956 12-Aug-15 12-Aug-15 1.00
100999956 13-Aug-15 13-Aug-15 1.00
100999956 14-Aug-15 17-Aug-15 4.00
100999956 18-Aug-15 18-Aug-15 1.00
100999956 19-Aug-15 19-Aug-15 1.00
100999956 20-Aug-15 20-Aug-15 1.00
100999956 21-Aug-15 21-Aug-15 1.00
100999956 22-Aug-15 24-Aug-15 3.00
100999956 25-Aug-15 25-Aug-15 1.00
100999956 26-Aug-15 26-Aug-15 1.00
100999956 27-Aug-15 27-Aug-15 1.00
100999956 28-Aug-15 28-Aug-15 1.00


Result Sheet (Sheet3)

Not in Data2

ID S Date E Date Days worked
100970513 21-Aug-15 21-Aug-15 1.00
100970513 22-Aug-15 24-Aug-15 3.00
100970513 25-Aug-15 25-Aug-15 1.00
100970513 26-Aug-15 26-Aug-15 1.00
100970513 27-Aug-15 27-Aug-15 1.00
100970513 28-Aug-15 28-Aug-15 1.00
100970513 29-Aug-15 31-Aug-15 3.00
100970513 01-Sep-15 01-Sep-15 1.00
100970513 02-Sep-15 02-Sep-15 1.00
100970513 03-Sep-15 03-Sep-15 1.00
100970513 04-Sep-15 04-Sep-15 1.00


Not in Data1

ID S Date E Date Days worked
100820087 14-Jul-15 14-Jul-15 1.00
100820087 19-Aug-15 19-Aug-15 1.00
100820859 31-Aug-15 31-Aug-15 0.50
100820859 01-Sep-15 01-Sep-15 1.00
100820859 02-Sep-15 02-Sep-15 1.00
100820859 03-Sep-15 03-Sep-15 1.00
100820859 04-Sep-15 04-Sep-15 1.00
100820859 08-Sep-15 08-Sep-15 1.00
100820859 09-Sep-15 09-Sep-15 1.00
100820859 10-Sep-15 10-Sep-15 1.00
100820859 11-Sep-15 11-Sep-15 1.00
100820859 12-Sep-15 14-Sep-15 3.00
100820859 15-Sep-15 15-Sep-15 1.00
100820859 16-Sep-15 16-Sep-15 1.00
100820859 17-Sep-15 17-Sep-15 1.00
100820859 18-Sep-15 18-Sep-15 1.00
100820859 19-Sep-15 21-Sep-15 3.00
100820859 22-Sep-15 22-Sep-15 1.00
100820859 23-Sep-15 23-Sep-15 1.00
100820859 24-Sep-15 24-Sep-15 1.00
100820859 25-Sep-15 25-Sep-15 1.00
100821359 10-Sep-15 10-Sep-15 1.00
100821359 11-Sep-15 11-Sep-15 1.00
100821359 12-Sep-15 14-Sep-15 3.00
100821359 15-Sep-15 15-Sep-15 1.00
100821359 16-Sep-15 16-Sep-15 1.00
100821359 17-Sep-15 17-Sep-15 1.00
100821359 18-Sep-15 18-Sep-15 1.00
100821359 19-Sep-15 21-Sep-15 3.00
100821359 22-Sep-15 22-Sep-15 1.00
100821359 23-Sep-15 23-Sep-15 1.00
100821417 22-Jul-15 22-Jul-15 1.00
100821417 23-Jul-15 23-Jul-15 1.00
100821417 24-Jul-15 24-Jul-15 1.00
100970513 28-Aug-14 28-Aug-14 1.00
100970513 04-Nov-14 04-Nov-14 1.00
100970513 12-Nov-14 14-Nov-14 3.00
100970513 21-Nov-14 23-Nov-14 3.00
100970513 24-Nov-14 28-Nov-14 5.00
100970513 29-Nov-14 30-Nov-14 2.00
100970513 01-Dec-14 01-Dec-14 1.00
100970513 25-Mar-15 25-Mar-15 1.00
100970513 30-Mar-15 31-Mar-15 2.00
100970513 22-Jun-15 26-Jun-15 5.00
100970513 27-Jun-15 30-Jun-15 4.00
100970513 04-Jul-15 06-Jul-15 3.00
100970513 07-Jul-15 07-Jul-15 0.50
100987480 16-Dec-14 16-Dec-14 1.00
100987480 18-Dec-14 19-Dec-14 2.00
100987480 23-Dec-14 23-Dec-14 1.00
100987480 02-Feb-15 02-Feb-15 1.00
100987480 04-Feb-15 04-Feb-15 1.00
100987480 13-Feb-15 13-Feb-15 1.00
100987480 19-Feb-15 19-Feb-15 1.00
100987480 08-Apr-15 08-Apr-15 1.00
100987480 10-Apr-15 10-Apr-15 1.00
100987480 15-Apr-15 15-Apr-15 1.00
100987480 16-Apr-15 16-Apr-15 1.00
100987480 24-Apr-15 26-Apr-15 3.00
100987480 27-Apr-15 30-Apr-15 4.00
100987480 01-May-15 05-May-15 5.00
100987480 06-May-15 06-May-15 1.00
100987480 07-May-15 07-May-15 1.00
100987480 11-May-15 11-May-15 1.00
100987480 13-May-15 13-May-15 1.00
100987480 18-May-15 18-May-15 1.00
100987480 26-May-15 26-May-15 1.00
100987480 27-May-15 27-May-15 1.00
100987480 28-May-15 28-May-15 1.00
100987480 29-May-15 29-May-15 1.00
100987480 04-Jun-15 04-Jun-15 1.00
100987480 05-Jun-15 05-Jun-15 1.00
100987480 09-Jun-15 09-Jun-15 1.00
100987480 08-Jul-15 17-Jul-15 10.00
100987480 21-Jul-15 21-Jul-15 1.00
100987480 24-Jul-15 24-Jul-15 1.00
100987480 28-Jul-15 28-Jul-15 1.00
100987480 29-Jul-15 29-Jul-15 1.00
100988516 01-Jun-15 16-Jun-15 16.00
100999956 01-Aug-15 01-Aug-15 1.00



Please fix the above bug and do the needful.

Thanks and Regards,
Motherindia
 
Upvote 0
Hello Mick Sir, Can you please help me out in getting the result what I expected.very very sorry to bother you so much.
 
Upvote 0
Try this for results on sheet3
NB:- All (Actual) data start on row2, Headers row 1.
Code:
[COLOR="Navy"]Sub[/COLOR] MG14Nov57
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Fd [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, oDts [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
  [COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
   [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]End[/COLOR] With
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        oDts = Dn.Offset(, 1).Value & "_" & Dn.Offset(, 2).Value
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(oDts) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Value).Add (oDts), Array(Dn.Offset(, 3).Value, Rng.Parent.Name)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   
  [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
  [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Fd = False
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
               Sp = Split(p, "_")
               [COLOR="Navy"]If[/COLOR] Dn.Value = k And CDate(Dn.Offset(, 1).Value) >= Sp(0) And CDate(Dn.Offset(, 2).Value) <= Sp(1) [COLOR="Navy"]Then[/COLOR]
                    Q = Dic(k).Item(p)
                        Q(0) = Q(0) - Dn.Offset(, 3).Value
                    Dic(k).Item(p) = Q
                    Fd = True
                    [COLOR="Navy"]Exit[/COLOR] For
               [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] p
    [COLOR="Navy"]Next[/COLOR] k
      oDts = Dn.Offset(, 1).Value & "_" & Dn.Offset(, 2).Value
     [COLOR="Navy"]If[/COLOR] Fd = False [COLOR="Navy"]Then[/COLOR]
         [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        oDts = Dn.Offset(, 1).Value & "_" & Dn.Offset(, 2).Value
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(oDts) [COLOR="Navy"]Then[/COLOR]
                Dic(Dn.Value).Add (oDts), Array(Dn.Offset(, 3).Value, Rng.Parent.Name)
        [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]End[/COLOR] If
    
     [COLOR="Navy"]Next[/COLOR] Dn


c = 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
        [COLOR="Navy"]If[/COLOR] Dic(k).Item(p)(0) > 0 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        .Cells(c, "A") = k
        .Cells(c, "B") = p
        .Cells(c, "C") = Dic(k).Item(p)
        .Cells(c, "D") = "Not in Sheet" & IIf(Dic(k).Item(p)(1) = "Sheet1", 2, 1)
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Status
Not open for further replies.

Forum statistics

Threads
1,223,926
Messages
6,175,425
Members
452,641
Latest member
Arcaila

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