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]
 
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 ?

Basically, i have a large list of buildings (300,00). each building has a unique identifier(RPUID). each record is a part of a building with the RPUID in column 6. I suppose each record would be unique with a combination of column 6(RPUID) and 9(Material/Equipment Category).

Current code produces a unique list of RPUIDs and lowest dates with MDIs.

I would like to be able to: check a list of RPUIDs on sheet4 A:A and produce a list of all of the records with that RDUID from that Dictionary.
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
If want to use the sheet4 RDUID and return mutliple records from your master list, that requires a different approach.
Are all RDUID's in Sheet4 going to be in the Master List ?
If yes then you would either use a filter approach or load Sheet4 into the dictionary and tag the items in the Master List that are in the Sheet4 dictionary.
Do RUID's appear multiple times in Sheet4 and if so what fields do you want to link to the Master List ?
What sheet does the output go to and what fields (from sheet4 and what from the Master list) ?

A more efficient approach would be to use Power Query.
 
Upvote 0
If want to use the sheet4 RDUID and return mutliple records from your master list, that requires a different approach.
Are all RDUID's in Sheet4 going to be in the Master List ?
If yes then you would either use a filter approach or load Sheet4 into the dictionary and tag the items in the Master List that are in the Sheet4 dictionary.
Do RUID's appear multiple times in Sheet4 and if so what fields do you want to link to the Master List ?
What sheet does the output go to and what fields (from sheet4 and what from the Master list) ?

A more efficient approach would be to use Power Query.

1) Yes, all RPUIDs from sheet 4 will be on the master list (Sheet2)
1)a. I would like to use the dictionary approach and tag
2) RPUIDs will only appear once in Sheet4
3) Results will go to Sheet5 (Sheet 4 will only have RPUIDs in column A. No need to pull this data to sheet 5. I would like to pull all of the data from the Master list. (22 columns)

I only posted with the 3 columns because i thought it would be easier to explain.....

On a side note, what would the filter approach look like? just curious as i am learning.. thank you!
 
Upvote 0
Possible approach
  • Read the Master into an array
  • Read Sheet4 into a dictionary
  • Look from Master to the dictionary and either move the selected items to an output array or flag the items to be selected for use in a filter.
You don't need your class object for this.

Alternatively you coud probably use either autofilter or advanced filter using your Sheet4 RPUIDs as the criteria.
 
Upvote 0
Man, I was really barking up the wrong tree with the dictionary. I like both. Seems like they could be very useful. Is there one that’s easier to implement? Or faster?

I’m curious about the flagging because there is other criteria down the road that I would like to use.

I am also curious about moving the selected items to an array because I will have to do that at some point as well…

Thank you for the back and fourth. Getting closer to wrapping my head around this!
 
Upvote 0
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.

VBA Code:
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
 
Upvote 1
Solution
Subscript out of range error....

Not sure whats going on but i will have a bit more time to investigate tomorrow. thank you so much for writing this! i will be studying it! once i can figure it out i will post back if it is successful.

perhaps it was my set up..




1676526961128.png
 
Upvote 0
Most likely the sheet names don't match. shtMstr should have around 22 columns (at least more than 6), shtData is sheet4 and only needs column A to have the RPUID in it.
 
Upvote 0
Most likely the sheet names don't match. shtMstr should have around 22 columns (at least more than 6), shtData is sheet4 and only needs column A to have the RPUID in it.
VBA Code:
 With shtMstr
        mstrLastRow = .Range("A" & Rows.Count).End(xlUp).row
        mstrLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set mstrRng = .Range(.Cells(4, "V"), .Cells(mstrLastRow, mstrLastCol))
        mstrArr = mstrRng.Value2
    End With

Works Awesome! just had to change the Set mstrRng = .Range(.Cells(2, "A"), .Cells(mstrLastRow, mstrLastCol)) to capture all of the data from Master Sheet! This is exactly what i have been looking for. Cant thank you enough! I am also curious about flagging. I have posted a new thread here How to add a flag for filtering a dictionary etc.

how long did it take you to write this?!
 
Upvote 0
Not that long maybe 20-30 mins and that is mainly because I try to customize variable names based on the information provided.
Unfortunately most OPs like to use generic names such as Sheet1 & Sheet2 etc and you finish up with code that is quite hard to follow.

Also half the battle if we don't get an XL2BB or link to a file is setting up some data to work with.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,836
Messages
6,181,251
Members
453,027
Latest member
Lost_in_spreadsheets

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