$15 To Amend Macro To Find The Next Available Earlier Or Previous Date

[pedros23]

Hi,

I have a workbook with a few hundred tabs on it (one for each of our customers)

Basically each one is a for a pot of money by which they can order stock from us and can increase from time to time according to their agreement with us.

I need to be able to report what the balance of each customers fund is on any given date.

I have the following macro which searches for the date and returns the figures on the summary page.


Option Explicit

Sub Summary()
Dim w As Worksheet
Dim i As Long
'Dim rng As Range
Dim d As Date
Dim lrng As Range
Dim lr As Long
d = InputBox("What Date to Search")
'Dim wsFunc As WorksheetFunction
'Set wsFunc = Application.WorksheetFunction


For Each w In Worksheets
If w.Name <> "Summary" Then
'Set rng = w.Range("L6:L" & Range("L" & Rows.Count).End(xlUp).Row)
Set lrng = w.Range("L:M")
lr = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row

For i = 6 To w.Range("L" & Rows.Count).End(xlUp).Row
On Error Resume Next
'If w.Range("L" & i) = wsFunc.VLookup(d, lrng, 2, False) Then
If w.Range("L" & i) = d Then
w.Range("L" & i).Resize(, 2).Copy
Sheets("Summary").Range("B" & lr + 1).PasteSpecial Paste:=xlValues
Sheets("Summary").Range("A" & lr + 1) = w.Name
End If
Next i
End If
Next w
MsgBox ("Complete")

End Sub

The issue I have is that there will be customers with no orders on the specified date, therefore I need it to return the figure for the next available previous date.

Thanks in advance.

[Admin]

Hi

I'll have a look.

Questions:

1. which column determines whether a particular date has order or not ?
2. if a date has multiple entries, what would be the outcome ?

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg (https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1 (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg (https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg)
https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg (https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9 (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (ttps://www.youtube.com/watch?v=LP9fz2DCMBE)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (ttps://www.youtube.com/watch?v=bFxnXH4-L1A)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[pedros23]

Hi

I'll have a look.

Questions:

1. which column determines whether a particular date has order or not ?
2. if a date has multiple entries, what would be the outcome ?

Hi Admin,

Thanks for looking at this.

To answer your questions.

1: Column L has all of the dates in it, which should all be in order (oldest to newest)
2: If there are multiple entries for a given date then it needs to come back witht the last entry for that date.

Many Thanks

[Admin]

Hi

The code is ready. Once you confirm the payment, I'll post the code here. Check your PM for the PayPal details.

[pedros23]

Hi

The code is ready. Once you confirm the payment, I'll post the code here. Check your PM for the PayPal details.

Hi,

I don't have a PM from you

[Admin]

Sent the PM.

[pedros23]

Sent the PM.

Hi,

Just sent payment.

Thanks

[Admin]

Hi

Thanks.

Please find attached file. Let me know if you have any concern.

[pedros23]

Hi

Thanks.

Please find attached file. Let me know if you have any concern.

Hi,

Thanks for uploading this, however it doesn't seem to work as it should.

As a test I endered 21/01/2014 as the date, however it is picking up 06/09/2012 from sheet Q even though there are many enties after this.

Thanks

After further tests it seems to return the same date for sheet Q no matter what you enter.

[Admin]

Hi

Can you please try this ? Enter the search date in N3 on summary sheet (if the cell is different, refer the cell in the code)


Option Explicit

Sub Summaryv2()

Dim wksEach As Worksheet
Dim wksSummary As Worksheet
Dim dtDate As Date
Dim LastRow As Long
Dim lngLoop As Long
Dim dic As Object
Dim strKey As String
Dim Data

Const OutputDateFormat As Long = 4 'd-m-y (Repladce 4 with 3 if you want m-d-y format)

Set dic = CreateObject("scripting.dictionary")
Set wksSummary = ThisWorkbook.Worksheets("Summary")

'//cell where you will enter the search date
dtDate = wksSummary.Range("n3").Value '<<<< adjust this range

For Each wksEach In ThisWorkbook.Worksheets
If Not wksEach.Name = wksSummary.Name Then
With wksEach
LastRow = .Range("l" & .Rows.Count).End(xlUp).Row
Data = .Range("l6:m" & LastRow).Value2
For lngLoop = 1 To UBound(Data, 1)
If Len(Data(lngLoop, 1)) * Len(Data(lngLoop, 2)) Then
On Error GoTo Nxt
If CDate(Data(lngLoop, 1)) <= dtDate Then
dic.Item(.Name) = CDate(Data(lngLoop, 1)) & "|" & Data(lngLoop, 2)
Else
Exit For
End If
End If
Nxt:
Err.Clear: On Error GoTo 0
Next
Erase Data
End With
End If
Next

If dic.Count Then
With wksSummary
LastRow = .Range("a" & .Rows.Count).End(xlUp).Row
With .Range("a" & LastRow + 1)
.Resize(dic.Count).Value = Application.Transpose(dic.keys)
.Offset(, 1).Resize(dic.Count).Value = Application.Transpose(dic.items)
.Offset(, 1).Resize(dic.Count).TextToColumns Destination:=.Offset(, 1), Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, OutputDateFormat), Array(2, 1))
.Offset(, 1).Resize(dic.Count).NumberFormat = "dd-mmm-yyyy"
End With
End With
MsgBox "Complete"
End If

End Sub