Date disappearing after > checking in loop

bradmsg

New Member
Joined
Jan 30, 2023
Messages
32
Office Version
  1. 365
Platform
  1. Windows
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?




VBA Code:
[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]
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
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
 
Upvote 0
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 ?
VBA Code:
BLDG.InspectionDate= InspectionDate
 
Upvote 0
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?
 
Upvote 0
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)

Rich (BB code):
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
 
Last edited:
Upvote 0
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!
 
Upvote 0
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........
 
Upvote 0
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.

VBA Code:
    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
 
Last edited:
Upvote 0
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.

VBA Code:
    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
VBA Code:
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

VBA Code:
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.
1676504987879.png
 
Upvote 0
What is the aim of the exercise ?
Depending on what you are trying to do using a class object may just complicate things.
Do you have multiple records with the same RPUID MDI & Inspection Date ?
What output are you trying to get to ?
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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