VBA: Find Closest Date with Criteria and Return Value for large data set.

[tom0x]

Hi,

I have a VBA code i would like to create.

I have two data sets based on Transport sales. One is Adverts with Open/Close times. The second is Sale Times.

Sheet 1:

Time	Open/Close	Type
08:00	O	Cars
08:00	O	Trucks
08:00	O	Bikes
08:00	O	Shoes
09:30	C	Trucks
10:00	C	Bikes
10:00	O	Trucks
12:00	C	Cars
12:30	C	Trucks
13:30	C	Shoes

<TBODY>
</TBODY>

Sheet 2:

Time</SPAN>	Type</SPAN>	O/C
08:30</SPAN>	Cars</SPAN>	O
09:00</SPAN>	Bikes</SPAN>	O
09:00</SPAN>	Shoes</SPAN>	O
09:45</SPAN>	Trucks</SPAN>	C
10:30</SPAN>	Bikes</SPAN>	C
13:00</SPAN>	Shoes</SPAN>	O

<TBODY>
</TBODY><COLGROUP><COL><COL><COL></COLGROUP>

I need a macro to look at each Sale (Sheet 2), and return the value in column B (Open/Close). For the Type of transport. Output required in BOLD.

So for example, Sheet2: 09:45 Trucks, the advert before was 09:30 Trucks C. Therefore the advert was Closed for the sale. Hence the returned value needs to read C.

Conversely Sheet 2: 13:00 Shoes, the advert before was 08:00 Shoes O. Therefore the advert was Open and value returned should be O.

Thank you for your help.

tom0x

 

[Marcelo Branco]

If a solution using a formula is acceptable maybe this
(assumes data in Sheet1 A1:C11)

Array formula in Sheet2 C2 copied down
=INDEX(Sheet1!$B$2:$B$11,MATCH(A2,IF(Sheet1!$C$2:$C$11=B2,Sheet1!$A$2:$A$11)))

Confirmed with Ctrl+Shift+Enter, not just Enter

Hope this helps

M.

 

[tom0x]

Hi Marcelo,

This seems to work, thanks for your help.

However, is there a way of doing this within VBA, so that i can run for a much larger data set?

thanks,
tom

 

[Marcelo Branco]

Tom

See if this is what you want

Sub aTest()
    Dim vData As Variant, vSearch As Variant, vResult As Variant
    Dim lastRow1 As Long, lastRow2 As Long, bFound As Boolean, i As Long, j As Long
    
    With Sheets("Sheet1")
        'last row with data in Sheet1 and put data in a variant array
        lastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
        vData = .Range("A2:C" & lastRow1)
    End With
    
    With Sheets("Sheet2")
        'last row with data in Sheet2 and put data in a variant array
        lastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        vSearch = .Range("A2:B" & lastRow2)
        'ceate a variant array to keep the results
        vResult = .Range("C2:C" & lastRow2)
        
        'Loop through vSearch
        For i = LBound(vSearch, 1) To UBound(vSearch, 1)
            bFound = False
            'Loop backwards through vData
            For j = UBound(vData, 1) To LBound(vData, 2) Step -1
                'Check if same Type
                If vSearch(i, 2) = vData(j, 3) Then
                    'Check Time
                    If vSearch(i, 1) >= vData(j, 1) Then
                        'a result was found
                        bFound = True
                        'put the result in vResult
                        vResult(i, 1) = vData(j, 2)
                        Exit For
                    End If
                End If
            Next j
            If bFound = False Then vResult(i, 1) = "Not Found"
        Next i
        
        'Transfer at once vResult to Sheet2
        .Range("C2").Resize(UBound(vResult, 1)).Value = vResult
    End With
        
End Sub

M.

 

[Marcelo Branco]

Tom,

There is a typo in this code line (luckily it doesn't cause a problem)

For j = UBound(vData, 1) To LBound(vData, 2) Step -1

Please, correct to

For j = UBound(vData, 1) To LBound(vData, 1) Step -1