VBA matching to closest time

[ckdragon]

Hi all,

I am trying to finish off a VBA If statement but am struggling to find if its possible to match to the closest time to finalise a copy and paste.

Essentially the code looks through some data I have organised and says;

If a cell in Sheet1.Column A = Sheet2.Column A then
if Sheet1.Column B = Sheet2.Column B then
if Sheet1.Column C = Sheet2.Column C then

Copy those cells that match to Sheet 2 Columns X,Y, Z

The logic is that by structuring it like this the code will make sure that all 3 conditions are met in order before copying and pasting.

Column A + B could have the same data further in the data set, where column C is realistically the defining factor to kick off the copy and paste.

The thing is is that Column C is a time....

Sheet2. Column C is always a round number eg: 9:00 AM, 11:30AM, 6:00PM

But

Sheet1. Column C is a "real number" eg: 10:36:58 AM, 6:58:31 PM

and so I want to that If statement for Column C to go "this number is close enough (could be slightly earlier or slightly after) to what I'm looking for and therefore thats okay"

If anyone has the answer I would be super grateful!

Thank you

Sheet 1 layout

Type	Tracking Start Date	Tracking Start Time
Truck 1	3/28/22	10:36:58 AM
Truck 1	3/28/22	7:18:42 PM
Truck 1	3/29/22	8:58:36 AM
Truck 1	3/30/22	9:34:36 AM
Truck 1	3/30/22	9:46:18 AM
Truck 1	3/30/22	10:44:12 AM

Sheet 2 layout

Type	Booking Start Date	Booking Start Time
Truck 1	3/27/22	6:00:00 AM
Truck 1	3/28/22	10:30:00 AM
Truck 1	3/28/22	6:00:00 PM
Truck 1	3/30/22	8:00:00 AM
Truck 1	3/30/22	11:00:00 AM
Truck 1	3/30/22	1:30:00 PM

Expected output

Type	Booking Start Date	Booking Start Time	Booking End Time	Booking End Date	Tracking Start Date	Tracking Start Time
Truck 1	3/27/22	6:00:00 AM	12:00:00 AM	3/28/22	No Matching Data	No Matching Data
Truck 1	3/28/22	10:30:00 AM	3:30:00 PM	3/28/22	3/28/22	10:36:58 AM
Truck 1	3/28/22	6:00:00 PM	6:00:00 PM	3/29/22	3/28/22	7:18:42 PM
Truck 1	3/30/22	8:00:00 AM	10:30:00 AM	3/30/22	3/30/22	9:34:36 AM
Truck 1	3/30/22	11:00:00 AM	1:00:00 PM	3/30/22	3/30/22	10:44:12 AM

 

[6StringJazzer]

If you would like us to provide actual code, then please provide your actual code for modification. In this case I will just have to guess.

Do not use nested If statements. Use a single boolean condition with And.

Dim CloseEnough As Double
CloseEnough = TimeSerial(0, 5, 0) ' 5 minutes--update to suit whatever your particular tolerance is for "slightly"

If Sheet1.Cells(Row, "A") = Sheet2.Cells(Row, "A") And _
   Sheet1.Cells(Row, "B") = Sheet2.Cells(Row, "B") And _
   Abs(Sheet1.Cells(Row, "C") - Sheet2.Cells(Row, "C")) <= CloseEnough Then

One other note:

Column C is always a round number eg: 9:00 AM, 11:30AM, 6:00PM

But

Sheet1. Column C is a "real number" eg: 10:36:58 AM, 6:58:31 PM

All times in Excel are real numbers, even if it's a whole number of hours. This is critical in understanding how to compare times in Excel. For example, 9:00 is stored as 0.375. Many of these "round numbers" cannot be stored exactly in binary format, which wreaks havoc when you try to compare them.

 

[ckdragon]

If you would like us to provide actual code, then please provide your actual code for modification. In this case I will just have to guess.

Do not use nested If statements. Use a single boolean condition with And.

Dim CloseEnough As Double
CloseEnough = TimeSerial(0, 5, 0) ' 5 minutes--update to suit whatever your particular tolerance is for "slightly"

If Sheet1.Cells(Row, "A") = Sheet2.Cells(Row, "A") And _
   Sheet1.Cells(Row, "B") = Sheet2.Cells(Row, "B") And _
   Abs(Sheet1.Cells(Row, "C") - Sheet2.Cells(Row, "C")) <= CloseEnough Then

One other note:


All times in Excel are real numbers, even if it's a whole number of hours. This is critical in understanding how to compare times in Excel. For example, 9:00 is stored as 0.375. Many of these "round numbers" cannot be stored exactly in binary format, which wreaks havoc when you try to compare them.

HI Jeff,

Thank you so much for this and for explaining the time thing, I think this is causing more havoc than I realised.

Sorry I didn't upload the code - I didn't think it would be so complicated if I am honest.

Since I have posted I have had to make some changes as there is now some slight complexities with the data.

I tried adding in your time component and made those and changes (I think the nested If statements were the reason the code wasn't really working in the first place), but unfortunately it still didn't work, I have added the code that I have below if you are able to advise anything that would be great.

For note:
> the paste value and location works for where it needs to go (below headers and other data etc)
> I haven't really figured out how to get the VBA to look through and then copy and paste only rows that have data therefore I have been using i & e variables to identify the starting row in each sheet and then just putting a number of row to look through (10 is what I'm trialing with) - I dont know if this is the best use for what I am trying to do regardless
> the first search column I am trying to find a partial match as there are some entries that have additional data in the cells (in the copy sheet), which is not important, but seemed to be throwing out an = search function

Any guidance would be really appreciated.

Thank you!

Public Sub matchingandpasting()

Application.ScreenUpdating = False

Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim closeenough As Double
For i = 2 To 10
For e = 8 To 10
Set copySheet = Worksheets("Sheet3")
Set pasteSheet = Worksheets("Sheet1")

closeenough = TimeSerial(0, 5, 0)

If copySheet.Cells(i, 1).Value Like "*" & pasteSheet.Cells(e, 2).Value & "*" And _
copySheet.Cells(i, 2).Value = pasteSheet.Cells(e, 6).Value And _
Abs(copySheet.Cells(e, 3) - pasteSheet.Cells(e, 7)) <= closeenough Then

copySheet.Cells(i, 2).Copy pasteSheet.Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).PasteSpecial
copySheet.Cells(i, 3).Copy pasteSheet.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).PasteSpecialxlPasteValues

Else
pasteSheet.Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).Value = "No Matching Data"
pasteSheet.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).Value = "No Matching Data"

End If

Next
Next

End Sub