Excel-Vba - Double/Date/Time matching and tolerance - excel

My code so far is like this:
Sub FindMatchingValue()
Dim i As Integer, TimeValueToFind As Date
TimeValueToFind = "04:00:00"
Sheets("Vessels").Range("F07").ClearContents
For i = 1 To 25 '
If CDate(Sheets("Vessels").Cells(i, 1).Value) = TimeValueToFind Then
MsgBox ("Found value on row " & i)
Sheets("Vessels").Range("F07").Value = Cells(i, 1).Offset(1, 1).Resize(1).Value
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
This code checks Column A for the time inputted in the format xx:xx:xx Both where the input is, and where the times are written are set as "Time" format.
Initially the CDate edit was not added. And this caused the code to always return false because, as it had been put, I was trying to "compare apples to oranges".
However adding the CDate addition produces a mismatch error. Similarly changing both to be a double also did not work:
Sub FindMatchingValue()
Dim i As Integer, TimeValueToFind As Date
TimeValueToFind = "04:00:00"
Sheets("Vessels").Range("F07").ClearContents
For i = 1 To 25 '
If Sheets("Vessels").Cells(i, 1).Value = CDbl(TimeValueToFind) Then ' < This was the line changed
MsgBox ("Found value on row " & i)
Sheets("Vessels").Range("F07").Value = Cells(i, 1).Offset(1, 1).Resize(1).Value
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
However this one is a different reason, since Excel stores the values as floating points, each value is still different. "It is well known that the expression a==b is likely to return False when a and b are both doubles, even though you might think they are the same. This is due to the finite precision with which floating point numbers are stored."
The way around this would be to Set a tolerance. If abs(a-b)<tolerance Then
However i'm not particularly sure which tolerance to use nor how to write it to include without messing up the first loop.
I wonder if anyone could shed some light on this and direct me to which additions I need to make and what sort of tolerances would be acceptable? I think the question is essentially twofold. Thank you in advance!

Use TimeValue() or TimeSerial() like so:
Sub SO()
Dim x As Date
Dim y As Date
Dim z As Date
x = TimeValue("04:00:00")
y = TimeSerial(4, 0, 0)
z = CDate(Range("A1").value) '// A1 has "04:00:00" entered
Debug.Print x = y '// True
Debug.Print y = z '// True
Debug.Print x = z '// True
End Sub
Putting this into the context of your code:
Sub FindMatchingValue()
Dim i As Integer, TimeValueToFind As Date
TimeValueToFind = TimeValue("04:00:00")
Sheets("Vessels").Range("F07").ClearContents
For i = 1 To 25 '
If CDate(Sheets("Vessels").Cells(i, 1).value) = TimeValueToFind Then
MsgBox ("Found value on row " & i)
Sheets("Vessels").Range("F07").value = Cells(i, 1).Offset(1, 1).Resize(1).value
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub

You are correct that the imprecision of floating point numbers is the cause of your problem. Remember that the underlying data in a Date data type is still a Double, formatted to look like a date.
The question of "...what sort of tolerances would be acceptable?" is really up to you. Given that your test value is "hh:mm:ss" then equal to the second may suffice.
There are many ways to achieve this. If your data is formatted as "hh:mm:ss" then this will work
If CDate(Sheets("Vessels").Cells(i,1).Text) = TimeValueToFind Then
This relies on the format applied to the sheet being to the same precision as your test value

For those interested, here is the answer:
Sub FindMatchingValue()
Dim i As Integer, TimeValueToFind As Date, Delta As Double, Tolerance As Double
TimeValueToFind = Sheets("Vessels").Range("F06")
Tolerance = 0.001
Sheets("Vessels").Range("F07").ClearContents
For i = 2 To 25 '
Delta = Sheets("Vessels").Cells(i, 1).Value - CDbl(TimeValueToFind)
If Abs(Delta) <= Tolerance Then
MsgBox ("Found value on row " & i)
Sheets("Vessels").Range("F07").Value = Cells(i, 1).Offset(0, 1).Resize(1).Value
Exit Sub
End If
Next i
MsgBox ("Value not found in the range!")
End Sub
So any time in the box F06 typed in, it now finds. A combination of tolerance was used and also converting to a Double. i = 1-25 was changed to 2-25, because I had a text header and that was producing a mismatch error.

Related

Automatically inserting Colon (:) in multiple columns under the Options Explicit

I was looking for a code to automatically insert the ':' (colon) into the columns R and S, W and X, and found code that I thought I could customise to my needs, but I am facing two issues:
The code works in R and S, but also need the code to run in columns W and X as well
I get an error:
Variable not Defined - stopping at TLen and I guess it will also stop at TimeV
The programmer doesn't use the Option Explicit, (it works OK without Option Explicit). But all my code is always with Option Explicit, but I'm not sure how to write the Dim for the two variables.
This code is in a specific worksheet, in the Worksheet_Change sub, where I have other code for other things, like the timestamp when people make a selection from column B, it will automatically populate when a selection is made in column B.
I have tried the colon code in another workbook, without the Option Explicit and it works without giving errors.
The source of the code came from
Excel VBA tips n tricks #12 no more colons when typing time of day, type 123 instead of 01colon23 AM
I've adapted the code to reference columns R and S in the code below.
Private Sub Worksheet_Change(ByVal Target As Range)
' This code will ADD the COLON for TIME automatically
' The code is from: https://www.youtube.com/watch?v=ATxaNbTV2d0 (Excel is Fun -
' Excel VBA Tips n Tricks #12 NO MORE COLONS When Typing Time of Day, Type 123 instead of 01colon23 AM
' To avoid an error if you select more than 1 cell, this next line of code will exit the sub
If Selection.Count > 1 Then
Exit Sub
End If
If Not Intersect(Range("R4:S1200"), Target) Is Nothing Then
TLen = Len(Target)
[![Layout of Worksheet and sample of the columns that need automatic insertion of colons ][1]][1]
If TLen = 1 Then
TimeV = TimeValue(Target & ":00")
ElseIf TLen = 2 Then
TimeV = TimeValue(Target & ":00")
ElseIf TLen = 3 Then
TimeV = TimeValue(Left(Target, 1) & ":" & Right(Target, 2))
ElseIf TLen = 4 Then
TimeV = TimeValue(Left(Target, 2) & ":" & Right(Target, 2))
ElseIf TLen > 4 Then
'Do nothing
End If
'Target.NumberFormat = "HH:MM"
Application.EnableEvents = False
Target = TimeV
Application.EnableEvents = True
End If
End Sub
Expand the range of the Intersect Intersect(Range("R:S,W:X"),Target).
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If IsNumeric(Target) = False Then
MsgBox Target & " is not a number", vbExclamation
Exit Sub
ElseIf Intersect(Range("R:S,W:X"), Target) Is Nothing Then
Exit Sub
End If
Dim n As Long
n = Len(Target)
If n >= 1 And n <= 4 Then
Application.EnableEvents = False
Target.NumberFormat = "hh:mm"
If n <= 2 Then
Target.Value2 = TimeSerial(Target, 0, 0)
Else
Target.Value2 = TimeSerial(Int(Target / 100), Target Mod 100, 0)
End If
Application.EnableEvents = True
End If
End Sub
I understand that you are 'stretching & teaching' me to work things out for myself, and it is appreciative (and I definitely have learned how to see the type (1.)). But in this instance, the 'Type' is coming as Variant/Date, even though it is meant to be time (maybe I am misunderstanding the syntax). – TheShyButterfly
You did well! Yes, that is one way to find the type. The other way is to use the VarType function:
Option Explicit
Sub Sample()
Dim TimeA
TimeA = TimeValue("01:00 PM")
MsgBox VarType(TimeA)
End Sub
This will give you 7 which is vbDate.
You can also store time as Variant and Double as shown below.
Option Explicit
Sub Sample()
Dim TimeA As Date
Dim TimeB As Double
Dim TimeC As Variant
TimeA = TimeValue("01:00 PM")
TimeB = TimeValue("01:00 PM")
TimeC = TimeValue("01:00 PM")
MsgBox "Time stored as Date : " & TimeA
MsgBox "Time stored as Double : " & TimeB
MsgBox "Time stored as Variant : " & TimeC
MsgBox "TimeA formated as Date : " & Format(TimeA, "hh:mm:ss AM/PM")
MsgBox "TimeB formated as Date : " & Format(TimeB, "hh:mm:ss AM/PM")
MsgBox "TimeC formated as Date : " & Format(TimeC, "hh:mm:ss AM/PM")
End Sub
but without an example how am I to learn, I have obviously exhausted my search on resolving this, but found nothing .. the reason why I posted the question. Thank you for encouraging me to continue solving things on my own :) TheShyButterfly
You can write the range as CDP1802 shown in his post or you can use the Application.Union method (Excel).
For example,
Option Explicit
Sub Sample()
Dim rngA As Range
Dim rngB As Range
Dim rngCombined As Range
Set rngA = Range("R4:S1200")
Set rngB = Range("W4:X1200")
Set rngCombined = Union(rngA, rngB)
MsgBox rngCombined.Address
End Sub
So in your code it becomes Intersect(rngCombined, Target) Is Nothing.
Also since you are working with Worksheet_Change and Events, I recommend seeing Working with Worksheet_Change.

Having issue with year() function

Im trying to create a module to pull data from a giant spreadsheet that I have on another sheet by year. Every part of the code works except for the part that matches the year to a user entered year.
Here's how I defined the user input and how I tried to write the if statement.
Dim y As variant
y = InputBox("Input year here")
If Year(RptSht.Cells(i, 2)) = y
At this point I get a type mismatch (I've tried setting y as an integer instead). Also just as a note I can use
Year(RptSht.Cells(i, 2))
to get a value, it just mismatches with y. Any help would be appreciated.
If Year(RptSht.Cells(i,2)) = y
That's doing too many things. Split it up.
First you want to get the cell at (i, 2):
Dim yearCellValue As Variant
yearCellValue = RptSht.Cells(i, 2)
Now, we can't just assume that yearCellValue is a valid date. We have to know it, otherwise if anything is wrong with the assumption, we'll likely run into a type mismatch error. Use the IsDate function to make sure you're looking at a Date value:
If IsDate(yearCellValue) Then
End If
Inside that conditional block, Year(yearCellValue) is safe. Outside of it, it isn't.
If IsDate(yearCellValue) Then
If Year(yearCellValue) = y Then
'...
End If
End If
Problem is, we don't know that y is a valid value either.
Dim y As variant
y = InputBox("Input year here")
If Not IsNumeric(y) Then Exit Sub 'bail out, we can't go any further.
Here is one way to handle the issue:
Sub gotimm()
Dim y As Long, RptSht As Worksheet, i As Long
y = Application.InputBox(Prompt:="Input year here", Type:=1)
Set RptSht = ActiveSheet
i = 1
With RptSht
If IsDate(.Cells(i, 2)) Then
If .Cells(i, 2) = y Then
MsgBox "match"
Else
MsgBox "nomatch"
End If
Else
MsgBox "no date in cell " & .Cells(i, 2).Address
End If
End With
End Sub
I guess the problem is that i is not assigned or (i,2) is not a date. Try this:
Sub TestMe()
Dim y As Variant
Dim i As Long
y = InputBox("Input year here")
i = 5
If IsDate(Worksheets(1).Cells(i, 2)) Then
If Year(Worksheets(1).Cells(i, 2)) = y Then
'Logic here
End If
End If
End Sub
Thus, the i is 5 and the reference cell is B5. The IsDate() checks whether the cell is a date.

VBA Date Format For Variable

I need to turn content in a spreadsheet column from text to a date.
The cell format is text and the inputters were instructed to input a date as "ddmmyyyy".
Accidents happened and I found some content that would not parse as a date, including entries like "Unknown".
So I used a variable declared as a date and wrote an error handler to deal with content that would not parse.
Now for the bit I cannot work out.
If the date was 3rd March 2000 and someone input that as "03332000" that will not parse because "33" cannot be a month or a day; it is caught by the error handler as I wanted.
But if it was input as "03132000" I can't think of a way of preventing VBA converting that to a valid date as "13/03/2000".
Declaring a format for the date variable will not prevent VBA parsing the date.
I can write something that tests number range of the day and month part of the string but that is extra lines of code and I was hoping to do it just by the error handler.
I'd approach it a little differently and let Excel do the work.
Public Function ValidateDate(ByVal strDate As String) As Boolean
Dim intDay As Integer, intMonth As Integer, intYear As Integer, dtDate As Date
ValidateDate = True
On Error GoTo IsInValid
If Len(strDate) <> 8 Then GoTo IsInValid
If Not IsNumeric(strDate) Then GoTo IsInValid
intDay = Left(strDate, 2)
intMonth = Mid(strDate, 3, 2)
intYear = Right(strDate, 4)
dtDate = DateSerial(intYear, intMonth, intDay)
If DatePart("d", dtDate) <> intDay Then GoTo IsInValid
If DatePart("m", dtDate) <> intMonth Then GoTo IsInValid
If DatePart("yyyy", dtDate) <> intYear Then GoTo IsInValid
Exit Function
IsInValid:
ValidateDate = False
End Function
... this will ensure that anything related to leap years etc. will still work correctly and it will ensure that all entries are validated correctly.
If you place:
03332000
in cell A1 and run:
Sub CheckDate()
Dim s As String, d As Date
s = Range("A1").Text
d = DateSerial(CInt(Right(s, 4)), CInt(Mid(s, 3, 2)), CInt(Left(s, 2)))
MsgBox s & vbCrLf & d
End Sub
You will get:
So even though a valid month can only be in the range [1-12], Excel is trying to "help" you by interpreting the 33 as a projection of future date. For example, if the month was entered as 13, Excel will treat it as December of the following year!
You can't rely on error-handling for this. You need checks like:
Sub CheckDate2()
Dim s As String, d As Date
Dim dd As Integer, mm As Integer, yr As Integer
s = Range("A1").Text
yr = CInt(Right(s, 4))
mm = CInt(Mid(s, 3, 2))
dd = CInt(Left(s, 2))
If yr = 0 Or yr < 1900 Then
MsgBox "year is bad"
Exit Sub
End If
If dd = o Or dd > 31 Then
MsgBox "day is bad"
Exit Sub
End If
If mm = 0 Or mm > 12 Then
MsgBox "month is bad"
Exit Sub
End If
d = DateSerial(yr, mm, dd)
MsgBox s & vbCrLf & d
End Sub
You can also do other checks like looking at the length of the field, etc.

Creating exact dates in Excel VBA by inputing only the day

In the following picture of an Excel sheet, the heading of the first column, and then of every 7th column after that, contains a month and a year.
I am trying to think of some code which would make entering complete dates under these headings faster. Since the month and the year are already present, I'm thinking there must be a way to enter just the day, and get the whole thing. For example, if "21" were entered in cell A26, "2/21/2015" would result.
Anyone have an idea for how I might get this output?
Edit: Thanks to the helpful replies on this forum, I figured out exactly how to do this. Here is the code for my finished product, in case anyone wants to do something similar:
Private Sub Worksheet_change(ByVal Selection As Range)
Set Sel = Selection
If Sel.Count > 1 Then
Exit Sub
End If
If (Sel.Column - 1) Mod 7 = 0 Or Sel.Column = 1 Then
'In my case, date columns always follow the pattern of 1, 8, 15...
If Sel.Value > 31 Or Sel.Value = "" Then
Exit Sub
Else
Sel.NumberFormat = "General"
Sel.Value = Left(Cells(1, Sel.Column), InStr(Cells(1, Sel.Column), ",") - 1) & " " & _
Sel.Value & Right(Cells(1, Sel.Column), 6)
Selection.NumberFormat = "m/d/yyyy"
End If
End If
End Sub
How about entering the day numbers, selecting the range where these day numbers are entered, and running the below:
Sub Add_month_year()
Dim c As Range
For Each c In Selection
c = Left(Cells(1, c.Column), InStr(Cells(1, c.Column), ",") - 1) & " " & _
c.Value & Right(Cells(1, c.Column), 6)
Next
End Sub
This should return the full dates in date code, which you can then format as you see fit.

How do I get VBA to recognize "001" for my loop?

I'm making a basic loop as follows:
Sub IntegerTestforSuffixFinder()
Dim i As Double
i = 1
MsgBox (i)
Do While i < 100
i = i + 1
If vbOK Then
MsgBox (i)
Else: End
End If
Loop
End Sub
This works just fine...but would I really need it to do for the actual problem I'm about to tackle is recognize i = 001. The zeroes are important place holders in this context, but it keeps correcting me to i = 1. Is there a way to stop this?
Much thanks!
You wouldn't. And you can't. But you can use the original Integer in your loop, and create a string that you can display. Try this and see if you can pull what you need from it:
Sub IntegerTestforSuffixFinder()
Dim i As Double
i = 1
MsgBox (i)
Do While i < 100
i = i + 1
If vbOK Then
'Original integer
MsgBox (i)
'3-character string created by using the Right() function
MsgBox Right("000" & i, 3)
Else: End
End If
Loop
End Sub
BTW, in your original example you realize you're starting your MsgBox at 2? You set i = 1, then you're adding 1 to it before displaying the first MsgBox. I'm thinking you probably want to move that i = i + 1 line to just before the Loop.
Try this:
Format cell - Custom. Look for Type with a "0". Type three "0" as below:
The value remains as integer.

Resources