Finding the nearest date in a column with reference to today

lenare

New Member
Joined
Mar 21, 2013
Messages
11
Hi everyone.

I am stuck trying to figure out a macro. Basically, I have a column of dates with details a few columns away. When I run the macro, I want it to
search for the closest (past) date with reference to the date when the macro was run.

For example, today is March 21, 2013, and I have March 1, 5, 10, 18, 22, 26 in the column of dates. When I run the macro I want it to generate the data from March 18 (being the closest date). Like the amount to the right of March 18. Afterwards, it would just move to the next worksheet and process the same set of commands. (the details will be shown on the first sheet, while the 2nd sheet until the nth sheet will contain all the data).

I have an ideas with the min function, where I'll subtract the column of dates to the date today, then see which one has the smallest positive (or negative) number. I have no idea how to actually translate this into code :| Please help!

P.S. The date isn't limited to just a month. It could be as long as 6 months or so. (not more than a year I think)
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Try:-
Temp is a range Object so you can refer to the row data as Temp.offset(,?) etc.
Code:
[COLOR=navy]Sub[/COLOR] MG24Mar33
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] temp [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] oMin [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
oMin = 365
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Date - Dn > 0 [COLOR=navy]Then[/COLOR]
       [COLOR=navy]If[/COLOR] (Date - Dn) < oMin [COLOR=navy]Then[/COLOR]
            oMin = Date - Dn
            [COLOR=navy]Set[/COLOR] temp = Dn
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
MsgBox temp
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Thanks for the quick reply! Will try this out tomorrow (as I do not have the files at home).
 
Upvote 0
Hello. So this is the code, but I'm still having some minor problems.

Dim ReportDate As Variant 'starting point for the week of the Loan/Maturity
report
Dim EndReportDate As Date 'uppper limit of the report
Dim ValueDate 'date of transaction
Dim RepriceDate As Date 'Reprice Date
Dim MaturityDate As Date 'Maturity Date
Dim OutstandingBalance As Double 'Outstanding Balance
Dim Cell As Range
Dim NumWS As Integer 'worksheet number
Dim RowNumReport As Long 'counting row number in the report page
Dim RowNumRepDate As Long 'counting row number in the worksheet of each
company (i.e. company A, company B etc.)
Dim rng As Range, dn As Range 'rng ~ reprice date used for loan balance
Dim temp2 As Range
Dim omin As Integer 'number of days
Sub LoanBalance()
ReportDate = Date
MsgBox ("Report of outstanding loan balances as of " & ReportDate)
NumWS = 2
RowNumRepDate = 14
RowNumReport = 5
Do While NumWS <= Worksheets.Count
Set rng = Range(Worksheets(NumWS).Range("h14"), Worksheets
(NumWS).Range("h" & Rows.Count).End(xlUp))
omin = 365
For Each dn In rng
If Date - dn > 0 Then
If (Date - dn) < omin Then
omin = Date - dn
Set temp2 = dn
End If
End If
Next dn
If temp2.Offset(0, 6) > 0 Then
Worksheets("Report").Range("F" & RowNumReport) =
temp2.Offset(0, 6) 'Outstanding Balance
Worksheets("Report").Range("A" & RowNumReport) = Worksheets
(NumWS).Range("C12") 'Ao
Worksheets("Report").Range("B" & RowNumReport) = Worksheets
(NumWS).Range("C2") 'Group Name
Worksheets("Report").Range("C" & RowNumReport) = Worksheets
(NumWS).Range("C1") 'Company Name
Worksheets("Report").Range("D" & RowNumReport) = Worksheets
(NumWS).Range("C3") 'Facility Type
Worksheets("Report").Range("E" & RowNumReport) =
temp2.Offset(0, -3) 'Current Rate
RowNumReport = RowNumReport + 1
temp = 1
NumWS = NumWS + 1
RowNumRepDate = 14
Else
NumWS = NumWS + 1
RowNumRepDate = 14
End If
Loop
If Not temp = 1 Then
MsgBox "You have no outstading loan balance as of " & ReportDate
Exit Sub
End If
 
Upvote 0
Hello. So this is the code, but I'm still having some minor problems.

Dim ReportDate As Variant 'starting point for the week of the Loan/Maturity
report
Dim EndReportDate As Date 'uppper limit of the report
Dim ValueDate 'date of transaction
Dim RepriceDate As Date 'Reprice Date
Dim MaturityDate As Date 'Maturity Date
Dim OutstandingBalance As Double 'Outstanding Balance
Dim Cell As Range
Dim NumWS As Integer 'worksheet number
Dim RowNumReport As Long 'counting row number in the report page
Dim RowNumRepDate As Long 'counting row number in the worksheet of each
company (i.e. company A, company B etc.)
Dim rng As Range, dn As Range 'rng ~ reprice date used for loan balance
Dim temp2 As Range
Dim omin As Integer 'number of days

Sub LoanBalance()
ReportDate = Date
MsgBox ("Report of outstanding loan balances as of " & ReportDate)
NumWS = 2
RowNumRepDate = 14
RowNumReport = 5
Do While NumWS <= Worksheets.Count
Set rng = Range(Worksheets(NumWS).Range("h14"), Worksheets
(NumWS).Range("h" & Rows.Count).End(xlUp))
omin = 365
For Each dn In rng
If Date - dn > 0 Then
If (Date - dn) < omin Then
omin = Date - dn
Set temp2 = dn
End If
End If
Next dn
If temp2.Offset(0, 6) > 0 Then
Worksheets("Report").Range("F" & RowNumReport) =
temp2.Offset(0, 6) 'Outstanding Balance
Worksheets("Report").Range("A" & RowNumReport) = Worksheets
(NumWS).Range("C12") 'Ao
Worksheets("Report").Range("B" & RowNumReport) = Worksheets
(NumWS).Range("C2") 'Group Name
Worksheets("Report").Range("C" & RowNumReport) = Worksheets
(NumWS).Range("C1") 'Company Name
Worksheets("Report").Range("D" & RowNumReport) = Worksheets
(NumWS).Range("C3") 'Facility Type
Worksheets("Report").Range("E" & RowNumReport) =
temp2.Offset(0, -3) 'Current Rate
RowNumReport = RowNumReport + 1
temp = 1
NumWS = NumWS + 1
RowNumRepDate = 14
Else
NumWS = NumWS + 1
RowNumRepDate = 14
End If
Loop
If Not temp = 1 Then
MsgBox "You have no outstading loan balance as of " & ReportDate
Exit Sub
End If
 
Upvote 0
As you can see, the code is still messy with all the extra variables (I just got them from a previous macro), but I can fix that later. I have 2 main problems:
1. When I run the macro, it presents the type mismatch error (13). Then it highlights the line "if date - dn > o then" I am not sure why, but this is probably triggered by the sheets with no data.
2. For some of the sheets, it only repeats the same value from the previous sheet. Im guessing this is because of the temp function (I'm thinking it carries over the range from the previous worksheet). Do we have a reset function for variables?

Please advise! Thanks.
 
Upvote 0
As you can see, the code is still messy with all the extra variables (I just got them from a previous macro), but I can fix that later. I have 2 main problems:
1. When I run the macro, it presents the type mismatch error (13). Then it highlights the line "if date - dn > o then" I am not sure why, but this is probably triggered by the sheets with no data.
2. For some of the sheets, it only repeats the same value from the previous sheet. Im guessing this is because of the temp function (I'm thinking it carries over the range from the previous worksheet). Do we have a reset function for variables?

Please advise! Thanks.
 
Upvote 0
It could be that your "Rng" is refering to the wrong sheet,,and therefore the variable Dn is not a date.
If you mean for the "Rng" variable to refer to sheet "NumWS" range "H14" down then try this to set the range.

Code:
With Worksheets("NumWS")
Set rng = .Range(.Range("H14"), .Range("H" & Rows.Count).End(xlUp))
End With

Try this bit of code after your "Set Rng = -" statement, to show which sheet it refers to.
Code:
MsgBox rng.Address(external:=True)
 
Last edited:
Upvote 0
Sorry for the double post. Will try to add your suggestions tomorrow. Thanks a lot! (again)
 
Upvote 0
After applying what you said, now it doesn't work anymore. With the first "with" statement, the macro prints an error statement. Before, it used to loop through the sheets but gets an error message at the end. When I stop running the macro, the first sheet gets populated by a few figures. But now it doesnt input any data.

Please advise!
 
Upvote 0

Forum statistics

Threads
1,213,552
Messages
6,114,278
Members
448,559
Latest member
MrPJ_Harper

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