Getting the value of an adjacent cell when using Excel Find via VBA

mikeymay

Well-known Member
Joined
Jan 17, 2006
Messages
1,645
Office Version
  1. 365
Platform
  1. Windows
I have a list if ID's in column A where some ID's are repeated and column B I have a list of dates.

I want to be able to find the latest date for a specific ID and wondered if the best way to do this is to use VBA code to use the 'Find & Replace' option to find each instance of the ID and establish if the date is greater than the one stored in memory.

So prior to the first instance of the ID there would be no stored date and the first instance would be stored as the date, then when the 2nd instance of the ID is found, if the date is greater then the stored date the this 2nd date is then stored in memory as the date, on so on until the last instance of the ID has been found.

I am struggling to work out what the code would be to do this so if anyone could help it would be appreciated.


TIA
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
So I have managed to put the following together which seems to be working but I am open to making this more efficient
Code:
Sheets("AD Visit Data").Select 'Sheets that holds the columns of ID's and dates
               
Set rngCoID = Range("N:N") 'Column that holds the ID's
               
If rngFormula.Offset(0, 3 + intQtrCount) = 0 Then ' this is just establishing if the re is a need to check the dates
   Else
   intDates = Application.WorksheetFunction.CountIf(rngCoID, rngFormula.Offset(0, -3)) ' This gets the number of instances of the ID - rngFormula.Offset(0, -3) is where the ID is held in the row
                  
   dtLastDate = 0 'Reset the date
                     
    rngCoID.Select 'Select the column holding the ID's
                     
    For intDateCount = 1 To intDates 'Loop through each instance of the date where the count is extablished above
         Selection.Find(What:=Sheets("AD Expected Data").Range("F" & intRow), After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
             SearchFormat:=False).Activate
                  
          If ActiveCell.Offset(0, -4) >= lngStart And ActiveCell.Offset(0, -4) <= lngEnd And ActiveCell.Offset(0, -4) > dtLastDate Then
              dtLastDate = ActiveCell.Offset(0, -4) 'If the active cell in the FIND is within a specified date range (a quarter)  and > stored date, then replace the stored date with the active cell date
              Else
          End If
     Next
End If
 
Upvote 0
If it is acceptable to sort your data, an alternative way :
- sort by ID then by date(descending)
- do a single find for the required ID and return the date relating to the cell found.
 
Upvote 0
I can see that actually.

The code I have takes a while to run as its about 10k rows long so your alternative might be much quicker.


Thanks
 
Upvote 0

Forum statistics

Threads
1,224,749
Messages
6,180,725
Members
452,995
Latest member
isldboy

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