Date disappearing after > checking in loop

[bradmsg]

Hi all. Trying to figure out why this date disappears. Trying to get the instance with the oldest date. Sheet 2 has a column (16) with dates. Column 6 has my column that im checking for duplicates if its a duplicate, i want it to grab the oldest date.

not sure why this date is disappearing. any ideas?

[CODE=vba]Sub Find()
Dim dict As New Dictionary
    
    Dim rg As Range
    Set rg = Sheet2.Range("A3").CurrentRegion
    
    Dim i As Long, RPUID As Long, InspectionDate As String
    Dim MDI As Long, BLDG As Class_BLDG
    
    For i = 4 To rg.Rows.Count
        RPUID = rg.Cells(i, 6).Value
        MDI = rg.Cells(i, 7).Value
        InspectionDate = CDate(rg.Cells(i, 16).Value)
        
        'Debug.Print InspectionDate
        
        If dict.Exists(RPUID) = True Then ' if exists then
            Set BLDG = dict(RPUID) 'get existing item at the key
        Else
            Set BLDG = New Class_BLDG 'initiates this instance for items not already in dictionary
            dict.Add RPUID, BLDG ' adds RPUID (Key) to THIS BLDG.
            
        End If
        'Debug.Print InspectionDate
        
        If BLDG.InspectionDate > InspectionDate Then
            InspectionDate = BLDG.InspectionDate
        End If
        Debug.Print BLDG.InspectionDate


         'BLDG.MDI = BLDG.MDI + MDI
        'BLDG.InspectionDate = InspectionDate ' Adds inspection date to THIS RPUID(Key)
        BLDG.MDI = MDI ' Adds MDI to THIS RPUID(Key)
        
        
    Next i
    
End Sub

[/CODE]

 

[Alex Blakenburg]

Here is a sample moving selected items to an array. You just need to add more criteria if you want to limit the output futher.
If you want to see it flagged for a filter it is a fairly simple change but maybe do it as separate thread.

Sub GetRPUID_Data()

    Dim shtData As Worksheet, shtMstr As Worksheet, shtOut As Worksheet
    Dim dataLastRow As Long, mstrLastRow As Long, mstrLastCol As Long
    Dim dataRng As Range, mstrRng As Range
    Dim dataArr As Variant, mstrArr As Variant, outArr As Variant
    Dim dictData As Object, dictKey As String
    Dim RPUID As Long
    Dim i As Long, iMstr As Long, jCol As Long, iOut As Long
    
    Set shtData = Worksheets("Sheet4")              ' <--- Use real sheet name
    Set shtMstr = Worksheets("Master")              ' <--- Use real sheet name
    Set shtOut = Worksheets("Sheet5")               ' <--- Use real sheet name
    
    With shtData
        dataLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set dataRng = .Range(.Cells(2, "A"), .Cells(dataLastRow, "A"))
        dataArr = dataRng.Value2
    End With
    
    With shtMstr
        mstrLastRow = .Range("A" & Rows.Count).End(xlUp).Row
        mstrLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set mstrRng = .Range(.Cells(2, "A"), .Cells(mstrLastRow, mstrLastCol))
        mstrArr = mstrRng.Value2
    End With
    
    ' Load shtData into Dictionary
    Set dictData = CreateObject("Scripting.dictionary")
    For i = 1 To UBound(dataArr)
        RPUID = dataArr(i, 1)
        dictKey = RPUID
        If Not dictData.exists(dictKey) Then
            dictData(dictKey) = i               ' Actual value not required for this scenario ie "" or empty would work
        End If
    Next i
    
    ' Set up output array
        ReDim outArr(1 To UBound(mstrArr, 1), 1 To UBound(mstrArr, 2))
    ' Loop through master and capture lines found in shtData based on dictionary into output array
    For iMstr = 1 To UBound(mstrArr)
        RPUID = mstrArr(iMstr, 6)
        dictKey = RPUID
        
        If dictData.exists(dictKey) Then                    ' Add any additional criteria here
            iOut = iOut + 1
            For jCol = 1 To UBound(mstrArr, 2)
                outArr(iOut, jCol) = mstrArr(iMstr, jCol)
            Next jCol
        End If
    Next iMstr

    ' Write back output array
    With shtOut
        .Range("A2").Resize(iOut, UBound(outArr, 2)).Value2 = outArr
        shtMstr.Range("A1").Resize(1, UBound(outArr, 2)).Copy Destination:=.Range("A1").Resize(1, UBound(outArr, 2))
        .Range("A2").Resize(iOut, UBound(outArr, 2)).EntireColumn.AutoFit
    End With

End Sub

 

[bebo021999]

Not sure what had happenned. But, try to use .value2, instead of .value for cells those are date
for ex:
RPUID = rg.Cells(i, 6).Value
become
RPUID = rg.Cells(i, 6).Value2

 

[Alex Blakenburg]

I agree with bebo on the value2 but shouldn't there be a line that looks like the below in the code somewhere ?
Where are you putting the date "into" the class object ?

BLDG.InspectionDate= InspectionDate

 

[bradmsg]

The way I understand, BLDG.InspectionDate > InspectionDate is checking the current data in BLDG.InspectionDate to the current iteration InspectionDate.

Ahh should I put BLDG.InspectionDate= InspectionDate Under If dict.Exists(RPUID) = True Then to make sure the first iteration has that data?

 

[Alex Blakenburg]

I don't have a copy of your class module or any sample data from you (XL2BB) so I haven't tested this but see if these changes help.
Note: Test if BLDG.InspectionDate = "" works when you haven't added anything into BLDG.InspectionDate in case you need to test for IsEmpty or = 0 instead.

I suspect you may already have seen this but Paul Kelly's video covers a very similar example (14.5 mins)

Sub FindEarliestDate()
    Dim dict As New Dictionary
 
    Dim rg As Range
    Set rg = Sheet2.Range("A3").CurrentRegion
 
    Dim i As Long, RPUID As Long, InspectionDate As String
    Dim MDI As Long, BLDG As Class_BLDG
 
    For i = 4 To rg.Rows.Count
        RPUID = rg.Cells(i, 6).Value
        MDI = rg.Cells(i, 7).Value
        InspectionDate = CDate(rg.Cells(i, 16).Value2)      ' XXX Changed to Value2
     
        'Debug.Print InspectionDate
     
        If dict.Exists(RPUID) = True Then ' if exists then
            Set BLDG = dict(RPUID) 'get existing item at the key
        Else
            Set BLDG = New Class_BLDG 'initiates this instance for items not already in dictionary
            dict.Add RPUID, BLDG ' adds RPUID (Key) to THIS BLDG.
        End If
        'Debug.Print InspectionDate
     
        ' XXX Changed --> store InspectionDate if Lower but not if empty
        If BLDG.InspectionDate = "" Or (BLDG.InspectionDate > InspectionDate And InspectionDate <> 0) Then
            BLDG.InspectionDate = InspectionDate
        End If
     
        Debug.Print BLDG.InspectionDate

         'BLDG.MDI = BLDG.MDI + MDI
        'BLDG.InspectionDate = InspectionDate ' Adds inspection date to THIS RPUID(Key)
        BLDG.MDI = MDI ' Adds MDI to THIS RPUID(Key)
            
    Next i
 
End Sub

 

[bradmsg]

Solid logic! Once I am back with my data, I’ll give it a go. Thank you!!!! That also gives me some more examples for checking some other cells as a next step!

Yes, I think I watched it this morning!

 

[bradmsg]

Alex,

Your code worked! Thanks for your input!

Ahh should I put BLDG.InspectionDate= InspectionDate Under If dict.Exists(RPUID) = True Then to make sure the first iteration has that data?

Also worked.

Programming is rough. LOL

Next question. given my data structure, how would i add the current iteration of:

RPUID = rg.Cells(i, 6).Value
MDI = rg.Cells(i, 7).Value
InspectionDate = CDate(rg.Cells(i, 16

etc to the key of:

If dict.Exists(RPUID) = True Then ' if exists then
Set BLDG = dict(RPUID)

not sure of the syntax........

 

[Alex Blakenburg]

Unless your requirements have changed, ie looking for the earlliest date, it doesn't make sense to add the Date to the key.

I have been doing it this way (below):
Some people don't use a delimiter but if you need to troubleshoot it helps if you can read the key.
The delimiter needs to be something that will not occur in your data and the Pipe symbol is a popular choice (I occassionally use "~" (tilda) since it is even easier to read but it takes up more space in the text.
Use Split to break it back into its components.

    Dim dicKey As String
    dicKey = RPUID & "|" & MDI
    If Not dic.exists(dicKey) Then
        ' assign a value or if using an array to store details the array row no
    End If

 

[bradmsg]

Unless your requirements have changed, ie looking for the earlliest date, it doesn't make sense to add the Date to the key.

I have been doing it this way (below):
Some people don't use a delimiter but if you need to troubleshoot it helps if you can read the key.
The delimiter needs to be something that will not occur in your data and the Pipe symbol is a popular choice (I occassionally use "~" (tilda) since it is even easier to read but it takes up more space in the text.
Use Split to break it back into its components.

    dicKey As String
    dicKey = RPUID & "|" & MDI
    If Not dic.exists(dicKey) Then
        ' assign a value or if using an array to store details the array row no
    End If

Yes, next I’ve taken out looking for the lowest date and would like to add each row that has the same RPUID to the key (RPUID). Your explanation flew right over me. Not sure how to implement this. I am posting the entire code below.

CLASS

Public SiteNumber As String
Public SiteName As String
Public ComplexName As String
Public BuildingNumber As String
Public BuildingName As String
Public RPUID As Long
Public MDI As Long
Public Component As String
Public MaterialEquipmentCategory As String
Public ComponentSubtype As String
Public SectionName As String
Public Quantity As Long
Public UoM As String
Public SectionInstallDate As String
Public InstallDateSource As String
Public InspectionDate As String
Public InspectionType As String
Public InspectionRating As Long
Public Inspector As String
Public InspectionComments As String
Public NumberInspectionImages As Long
Public SectionID As String

Sub dictionarySum() ' https://www.youtube.com/watch?v=o8fSY_4p93s

    Dim dict1 As Dictionary 'Declare dict1 in this sub

    Set dict1 = ReadData() 

    Call Writedict1(dict1) 

End Sub

Function ReadData() As Dictionary
    Dim dict1 As New Dictionary

    Dim rg As Range
    Set rg = Sheet2.Range("A3").CurrentRegion

    Dim i As Long, RPUID As Long, InspectionDate As String
    Dim MDI As Long, BLDG As Class_BLDG

    For i = 4 To rg.Rows.Count '4th row down --> last row
        RPUID = rg.Cells(i, 6).Value2
        MDI = rg.Cells(i, 7).Value2
        InspectionDate = rg.Cells(i, 16).Value2

        If dict1.Exists(RPUID) = True Then ' if exists then
            Set BLDG = dict1(RPUID) 'get existing item at the key
            
        Else
            Set BLDG = New Class_BLDG 'initiates this instance for items not already in dictionary
            dict1.Add RPUID, BLDG ' adds RPUID (Key) to THIS BLDG.
            BLDG.InspectionDate = InspectionDate ' Adds initial InspectionDate to THIS RPUID(Key)
            BLDG.MDI = MDI ' Adds initial MDI to THIS RPUID(Key)
        End If
        

    Next i

    Set ReadData = dict1 'setting this dict1

End Function

Sub Writedict1(dict1 As Dictionary)
    Dim rgOut As Range
    Set rgOut = Sheet3.Range("A2").CurrentRegion 'Set range for output
    'rgOut.Offset(1).CurrentRegion.Clear 'Clear all content and formatting
    rgOut.Offset(1).ClearContents


    Dim key As Variant, BLDG As Class_BLDG
    Dim row As Long
    row = 2 'start with row 2

    For Each key In dict1
        Set BLDG = dict1(key) 'set each key for instance
        rgOut.Cells(row, 1).Value = key 'output key in this column
        rgOut.Cells(row, 2).Value = BLDG.InspectionDate 'output item in this column
        rgOut.Cells(row, 3).Value = BLDG.MDI 'output item in this column
        'Debug.Print key, BLDG.InspectionDate, BLDG.MDI
        row = row + 1 ' moves to the next row
    Next key 'Moves to next item

End Sub

Unfortunately i cant download L2BB but here is what my data looks like on Sheet2.