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

**pedros23** · 04-15-2014, 07:09 PM

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.

Code:

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** · 04-15-2014, 09:37 PM

**pedros23** · 04-16-2014, 01:50 PM

Originally Posted by 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 ?

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** · 04-16-2014, 09:53 PM

Hi

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

**pedros23** · 04-17-2014, 12:49 PM

Originally Posted by Admin

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** · 04-17-2014, 08:31 PM

Sent the PM.

**pedros23** · 04-22-2014, 12:57 PM

Originally Posted by Admin

Sent the PM.

Hi,

Just sent payment.

Thanks

**Admin** · 04-22-2014, 11:26 PM

Hi

Thanks.

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

**pedros23** · 04-23-2014, 12:41 PM

Originally Posted by Admin

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** · 04-23-2014, 04:16 PM

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)

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