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

tom0x

New Member
Joined
Jan 12, 2015
Messages
2
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:
[TABLE="width: 144"]
<TBODY>[TR]
[TD="class: xl63, width: 64, bgcolor: transparent"]Time
[/TD]
[TD="class: xl63, width: 64, bgcolor: transparent"]Open/Close
[/TD]
[TD="class: xl63, width: 64, bgcolor: transparent"]Type
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]08:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]O
[/TD]
[TD="class: xl63, bgcolor: transparent"]Cars
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]08:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]O
[/TD]
[TD="class: xl63, bgcolor: transparent"]Trucks
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]08:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]O
[/TD]
[TD="class: xl63, bgcolor: transparent"]Bikes
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]08:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]O
[/TD]
[TD="class: xl63, bgcolor: transparent"]Shoes
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]09:30
[/TD]
[TD="class: xl63, bgcolor: transparent"]C
[/TD]
[TD="class: xl63, bgcolor: transparent"]Trucks
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]10:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]C
[/TD]
[TD="class: xl63, bgcolor: transparent"]Bikes
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]10:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]O
[/TD]
[TD="class: xl63, bgcolor: transparent"]Trucks
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]12:00
[/TD]
[TD="class: xl63, bgcolor: transparent"]C
[/TD]
[TD="class: xl63, bgcolor: transparent"]Cars
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]12:30
[/TD]
[TD="class: xl63, bgcolor: transparent"]C
[/TD]
[TD="class: xl63, bgcolor: transparent"]Trucks
[/TD]
[/TR]
[TR]
[TD="class: xl64, bgcolor: transparent"]13:30
[/TD]
[TD="class: xl63, bgcolor: transparent"]C
[/TD]
[TD="class: xl63, bgcolor: transparent"]Shoes
[/TD]
[/TR]
</TBODY>[/TABLE]

Sheet 2:

[TABLE="width: 203"]
<TBODY>[TR]
[TD="align: center"]Time</SPAN>[/TD]
[TD="align: center"]Type</SPAN>[/TD]
[TD="align: center"]O/C[/TD]
[/TR]
[TR]
[TD="align: center"]08:30</SPAN>[/TD]
[TD="align: center"]Cars</SPAN>[/TD]
[TD="align: center"]O[/TD]
[/TR]
[TR]
[TD="align: center"]09:00</SPAN>[/TD]
[TD="align: center"]Bikes</SPAN>[/TD]
[TD="align: center"]O[/TD]
[/TR]
[TR]
[TD="align: center"]09:00</SPAN>[/TD]
[TD="align: center"]Shoes</SPAN>[/TD]
[TD="align: center"]O[/TD]
[/TR]
[TR]
[TD="align: center"]09:45</SPAN>[/TD]
[TD="align: center"]Trucks</SPAN>[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]10:30</SPAN>[/TD]
[TD="align: center"]Bikes</SPAN>[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]13:00</SPAN>[/TD]
[TD="align: center"]Shoes</SPAN>[/TD]
[TD="align: center"]O[/TD]
[/TR]
</TBODY><COLGROUP><COL><COL><COL></COLGROUP>[/TABLE]


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
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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.
 
Upvote 0
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
 
Upvote 0
Tom

See if this is what you want

Code:
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.
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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