VBA matching to closest time

ckdragon

New Member
Joined
Apr 3, 2022
Messages
37
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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

TypeTracking Start DateTracking Start Time
Truck 13/28/2210:36:58 AM
Truck 13/28/227:18:42 PM
Truck 13/29/228:58:36 AM
Truck 13/30/229:34:36 AM
Truck 13/30/229:46:18 AM
Truck 13/30/2210:44:12 AM



Sheet 2 layout

TypeBooking Start DateBooking Start Time
Truck 13/27/226:00:00 AM
Truck 13/28/2210:30:00 AM
Truck 13/28/226:00:00 PM
Truck 13/30/228:00:00 AM
Truck 13/30/2211:00:00 AM
Truck 13/30/221:30:00 PM



Expected output

TypeBooking Start DateBooking Start TimeBooking End TimeBooking End DateTracking Start DateTracking Start Time
Truck 13/27/226:00:00 AM12:00:00 AM3/28/22No Matching DataNo Matching Data
Truck 13/28/2210:30:00 AM3:30:00 PM3/28/223/28/2210:36:58 AM
Truck 13/28/226:00:00 PM6:00:00 PM3/29/223/28/227:18:42 PM
Truck 13/30/228:00:00 AM10:30:00 AM3/30/223/30/229:34:36 AM
Truck 13/30/2211:00:00 AM1:00:00 PM3/30/223/30/2210:44:12 AM
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
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.

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

VBA Code:
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!

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

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

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