Extract names added on a date and also the name which are not present today.

[kuldeepjainesl]

Hello Helpers,

To explain the the situation i am take an example of classroom attendance. i have resistor for attendance of kids. Few kids come regular and few are irregular. i am putting the attendance status in a same colum with date. A colum has date and B colum has names.

For example:

1) Cell D2, the date is given for which the comparison to be done.
2) In Colum E, I need the new names appeared on 2-7-2016 which was not present on 1-7-2016
3) in colum F, Any name which was present on 1-7-2016 but not came today 2-7-2016

Always there will comparison of two dates only.

 

[Jigar B]

You can start with following code. Also attached file is having the same code and a button to prepare the list.

Sub PrepareList()
    Dim lastRow, lastRowPvt, i As Long
    Dim checkdate As Date
       
    If Sheets("Sheet1").Range("D1").Value = "" Then
        MsgBox "Enter valid date in cell D1"
        Exit Sub
    End If

    lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "E").End(xlUp).Row
    If lastRow > 1 Then
        Range("E2:E" & lastRow).ClearContents
    End If
   
    lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "F").End(xlUp).Row
    If lastRow > 1 Then
        Range("F2:F" & lastRow).ClearContents
    End If
   
    lastRow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    NewRange = "Sheet1!A1:B" & lastRow
    ThisWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").ChangePivotCache ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
    ThisWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").RefreshTable
   
    Set PvtTbl = Worksheets("Sheet2").PivotTables("PivotTable1")

    'delete all filters currently applied to the PivotTable, using the PivotTable.ClearAllFilters Method
    PvtTbl.ClearAllFilters
    checkdate = Sheets("Sheet1").Range("D1").Value
   
    prevdate = checkdate - 1
    PvtTbl.PivotFields("Date").PivotFilters.Add Type:=xlDateBetween, Value1:=Format(prevdate, "dd-mm-yyyy"), Value2:=Format(checkdate, "dd-mm-yyyy")
     
    lastRowPvt = Sheets("Sheet2").Cells.Find(What:="*", After:=Sheets("Sheet1").Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
   
    For i = 3 To lastRowPvt
        If Sheets("Sheet2").Range("B" & i) = "" Then
            Sheets("Sheet1").Range("E" & i) = Sheets("Sheet2").Range("A" & i).Value
        End If
        If Sheets("Sheet2").Range("C" & i) = "" Then
            Sheets("Sheet1").Range("F" & i) = Sheets("Sheet2").Range("A" & i).Value
        End If
    Next i
    PvtTbl.ClearAllFilters
    Sheets("Sheet1").Select
    Range("E:E").Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes
    Range("F:F").Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes
End Sub

 

[p45cal]

…or a userdefined function.
In the attached is a UDF NewLostNames which is an array-entered (committed to the sheet with Ctrl + Shift + Enter, not just Enter) formula giving a result 2 columns wide. This means the formula needs to entered into a range 2 columns wide and as many rows as you think you'll need.

In the attached, the formula =NewLostNames(D1,A1:B48) has been array-entered into the range H2:I10 all at once.

If the range you enter the formula into does not have enough rows to display all the results, you will see ++… after the name in the bottom-most cell, viz.:


I have used NARAYANK991's sheet from your other thread (http://forum.chandoo.org/threads/ex...o-the-name-which-are-not-present-today.30384/) and left his formulae so that you can compare results.

However, when testing for speed, you should not have NARAYANK991's formulae because you say this is slow with big data.

You've drawn the short straw with me with this UDF since I'm experimenting with different functions; FILTER in this case. There will be more elegant solutions for certain. Nor have I tried to make the UDF especially elegant - I just carried on until the result came right - no tidying up of the code either!

But this doesn't mean that the function will be slow - actually, I expect it will be quite fast, even with big data. I leave it to you to test and report back.

 

[kuldeepjainesl]

Speed improved in comparison to NNK solution. i really like the approach of adding ..++ as in indication to shortfall. Let me implement and see how the things move ahead. A big thanks to you

 

[p45cal]

Let me implement and see how the things move ahead

How fast?

 

[kuldeepjainesl]

it was at least 10 times after then earlier solution but as the data is expanding by leap and bound i could not implement it in the way i though. however i have collected this gem and will use some day where data condition will be favorable.

 

[Marc L]

Hi !

What about using a Dictionary object ? Around 25 codelines and faster !
​

 

[kuldeepjainesl]

What is "Dictionary object ? " How we can use ...

 

[Marc L]

Type Dictionary in VBE help search box : all is yet in VBA inner help !

First, activate Microsoft Scripting Runtime reference in Tools VBE menu …

Then run this demonstration on your sample workbook :​

Sub Demo1()
    Dim D As Date, DIC(1) As New Dictionary, Rd As Range, Rf As Range, R&, V
        D = Cells(4).Value - 1
With Cells(1).CurrentRegion.Columns(1)
    Set Rd = .Find(D, , xlValues, xlWhole)
    Set Rf = .Find(Cells(4).Value, SearchDirection:=xlPrevious)
End With
    R = Rd Is Nothing Or Rf Is Nothing
    If Not R Then V = Range(Rd, Rf(1, 2)).Value
    Set Rd = Nothing:  Set Rf = Nothing
    If R Then Beep: Exit Sub
For R = 1 To UBound(V)
    If V(R, 1) = D Then DIC(1).Item(V(R, 2)) = "" Else _
    If DIC(1).Exists(V(R, 2)) Then DIC(1).Remove V(R, 2) Else DIC(0).Item(V(R, 2)) = ""
Next
    Cells(4).CurrentRegion.Offset(1).Clear
    If DIC(0).Count Then [E2].Resize(DIC(0).Count).Value = Application.Transpose(DIC(0).Keys)
    If DIC(1).Count Then [F2].Resize(DIC(1).Count).Value = Application.Transpose(DIC(1).Keys)
    Erase DIC, V
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[kuldeepjainesl]

Its working champ. However i need to check it under actual data and will revert back with the performance.

Thank You

 

[kuldeepjainesl]

Unbelievable performance..... Just got tested on a test data and results are populated in just friction of second... Thanks a lot.

 

[Marc L]

Dictionary is fast but here fastest is to work in memory (V variable)
with only the couple of days data (if source data is huge) …

With few data, code could be easy as this :​

Sub Demo0()
    Dim DIC(1) As New Dictionary, D&, P&, R&, V
    D = Cells(4).Value2
    P = D - 1
    V = Cells(1).CurrentRegion.Value2
For R = 2 To UBound(V)
    Select Case V(R, 1)
      Case P:       DIC(1).Item(V(R, 2)) = ""
      Case D:       If DIC(1).Exists(V(R, 2)) Then DIC(1).Remove V(R, 2) Else DIC(0).Item(V(R, 2)) = ""
      Case Is > D:  Exit For
    End Select
Next
    Cells(4).CurrentRegion.Offset(1).Clear
    If DIC(0).Count Then [E2].Resize(DIC(0).Count).Value = Application.Transpose(DIC(0).Keys)
    If DIC(1).Count Then [F2].Resize(DIC(1).Count).Value = Application.Transpose(DIC(1).Keys)
    Erase DIC, V
End Sub

 

[kuldeepjainesl]

I got a bit confused here... You said the V variable is fastest and this code worked too. Great. Accept my thanks upfront.

But what is the mean of "only the couple of days data (if source data is huge) …"??

Let me share the quantum of data : i am expecting to have 13K rows per day so if we assume that we will have to compare data max for 30 days, we will have about 500K rows (1/2 of the spreadsheet capacity). In this situation which solution you suggest Demo 1 or Demo 0 as far as performance is concerned.

To me both are working fast as of now on 3-4 day data.

 

[Marc L]

Use Demo1 as it works only with the couple of days
(meaning day and previous day).
Maybe it could be a bit faster by separating days in memory process …

Demo0 scans from the beginning of data
and as I wrote « with few data » …
​

 

[kuldeepjainesl]

it explains everything.....Thanks

 

[Marc L]

Maybe it could be a bit faster by separating days in memory process …

Sub Demo2()
     Dim D(1) As Date, DIC(1) As New Dictionary, Rg As Range, N%, R&, V
         D(1) = Cells(4).Value
         D(0) = D(1) - 1
With Cells(1).CurrentRegion.Columns(1)
    For N = 0 To 1
       Set Rg = .Find(D(N), , xlValues, xlWhole)
        If Rg Is Nothing Then Beep: Erase DIC: Exit Sub
        V = Range(Rg(1, 2), .Find(D(N), SearchDirection:=xlPrevious)(1, 2)).Value
     If N = 0 Then
         For R = 1 To UBound(V):  DIC(1).Item(V(R, 1)) = "":  Next
     Else
         For R = 1 To UBound(V)
            If DIC(1).Exists(V(R, 1)) Then DIC(1).Remove V(R, 1) Else DIC(0).Item(V(R, 1)) = ""
         Next
     End If
    Next
End With
    Set Rg = Nothing
    Cells(4).CurrentRegion.Offset(1).Clear
    If DIC(0).Count Then [E2].Resize(DIC(0).Count).Value = Application.Transpose(DIC(0).Keys)
    If DIC(1).Count Then [F2].Resize(DIC(1).Count).Value = Application.Transpose(DIC(1).Keys)
    Erase DIC, V
End Sub

It may be faster than previous codes but for sure
it needs less memory as it stores only names for a day …

Change worksheet event can be used to extract names
each time date in D1 cell is updated …
​

 

[kuldeepjainesl]

For the benefit of all : It is possible that this library is either not on the corporate environment or not in the reference list.

You could try opening the macro in the corporate environment and checking the references. If it is not listed try looking for it in C:\Windows\System subfolder as Scrrun.dll

 

[Marc L]

If you don't want early binding of this dll
(no Microsoft Scripting Runtime reference),
you can declare an object in late binding like in Dictionary VBA inner help
as well like in the thread How to combine duplicate entries in one cell …
(No benefit at all except late binding, could be a bit slower.)

See also Early vs. Late Binding …


For MAC users or for those who do not want to use an external library,
Dictionary can be simulated by using inner Collection VBA object.
It's not fast as Dictionary but fast enough and requires
more VBA skills to handle a Collection as a Dictionary
either directly in code or through a class module …

For few data, no need a collection but just MATCH Excel worksheet function !
​

 

[Marc L]

With no need to activate any reference :​

Sub Demo3()
    Dim D(1) As Date, oCol As New Collection, Rg As Range, L&, N%, R&, S$, V, VA$()
        D(1) = Cells(4).Value
        D(0) = D(1) - 1
With Cells(1).CurrentRegion.Columns(1)
    For N = 0 To 1
       Set Rg = .Find(D(N), , xlValues, xlWhole)
        If Rg Is Nothing Then Beep: Exit Sub
        V = Range(Rg(1, 2), .Find(D(N), SearchDirection:=xlPrevious)(1, 2)).Value
     If N = 0 Then
        For R = 1 To UBound(V):  oCol.Add V(R, 1), V(R, 1):  Next
     Else
            ReDim VA(1 To UBound(V), 0)
            On Error Resume Next
        For R = 1 To UBound(V)
            S = oCol(V(R, 1))
            If Err.Number Then L = L + 1: VA(L, 0) = V(R, 1): Err.Clear Else oCol.Remove S
        Next
            On Error GoTo 0
     End If
    Next
End With
        Set Rg = Nothing
        Cells(4).CurrentRegion.Offset(1).Clear
        If L Then [E2].Resize(L).Value = VA
    If oCol.Count Then
       ReDim VA(1 To oCol.Count, 0)
        For R = 1 To oCol.Count:  VA(R, 0) = oCol(R):  Next
         [F2].Resize(oCol.Count).Value = VA
    End If
End Sub

Do you like it ? So thanks to click on bottom right Like !
​