Search list  
Author Message
AndersBank





PostPosted: Visual Basic for Applications (VBA), Search list Top

Hello! I have a small problem that I do not know exactly how to solve. I have a macro that that searches a list in Excel for a certain date e.g. 2006-02-14. The date is stored in the array strSlutDatumArray(1). I look using rng(1).Offset(j, 0) (never mind that but it just loops down in a list). I apply this code on many lists. Almost all lists consist of dates based on a 5 day week. However some lists only contain one date per week.

Assume that I am searching for the date 2006-01-10. The lists contain only 1 date per week. I want to somehow check so that I choose the date closest to 2006-01-10 in the list. Assume that the list looks like:

2006-01-01

2006-01-08

2006-01-15

Then I want to stop my search at the date closest to 2006-01-10, i.e. 2006-01-08. Can anyone help me with how to do that Any help is very much appreciated! Thanks a lot in advance!

The code I am using for searching the list is:

Do Until IsEmpty(rng(1).Offset(j, 0)) = True Or rng(1).Offset(j, 0).text = strSlutDatumArray(1) = True

j = j + 1

Loop



Microsoft ISV Community Center Forums3  
 
 
Derek Smyth





PostPosted: Visual Basic for Applications (VBA), Search list Top

Hello again AndersBank,

I've done something similar but with time. The approach I took, as it would apply to dates, is to search for the date, if it's not found take a day away and try the search again, if it's not found then add a day and try the search again, you keep doing this until you find the closest date either before or after the date your searching for.

Here is the code I used, you'll be able to adapt it.

Set rngStartRangeProcess = Application.Selection.Find(CStr(DateTime), LookIn:=xlValues)

'if date time not found then
If rngStartRangeProcess Is Nothing Then

Dim nRange As Integer
For nRange = 1 To 15 'for a range of 15 seconds
Dim newDateTime As Date
newDateTime = DateAdd("s", nRange, DateTime) 'add seconds
Set rngStartRangeProcess = Application.Selection.Find(CStr(newDateTime), LookIn:=xlValues) 'have another look

If rngStartRangeProcess Is Nothing Then 'if still not found
newDateTime = DateAdd("s", -nRange, DateTime) 'remove seconds
Set rngStartRangeProcess = Application.Selection.Find(CStr(newDateTime), LookIn:=xlValues) 'have another look
If Not rngStartRangeProcess Is Nothing Then 'if found then exit the for loop
Exit For
End If
Else
Exit For 'if found then exit loop
End If

Next
End If