Expert: Tom Ogilvy - 11/9/2009

Question
Hello Tom,
Remember, you wrote a custom formula to look up on the basis of both time range and B Number? Well its working fine. Could you please help me in enhancing the formula a bit including a time zone clause in this?
The formula you wrote was as follows:
Current formula = Findmatch(A1,B1,TableTime,TableB)
Anticipated formula= Findmatch(A1,B1,TableTime,TableB,GMT)
Where GMT is a value it could be +6 or -6. If i put 6, then it will consider by shifting the time to 6 hour.
For example
Table A:
Time    B #   Number of sec
2:45   1196025335   10

Table B:
Time    B #   Number of sec
8:46   1196025335   12

Previously, Findmatch(A1,B1,TableTime,TableB) would yield a result #N/A but now i want the formula to calculate that table is 6 hour lagging behind and now calculate if the time is withing 5 minute range.

Thank you for your great help as always.
Here is the previous formula that you wrote to me.

Option Explicit
Sub ShowValues()
Dim r As Range, cell As Range, res As Variant
Set r = Range("A3", Range("A3").End(xlDown))
For Each cell In r
 If cell.Row Mod 100 = 0 Then Debug.Print cell.Row
 res = FindMatch1(cell, cell.Offset(0, 1), Range("Time_Small"), Range("B_Small"))
 If Not IsError(res) Then
    cell.Offset(0, 4).Value = res
 Else
    cell.Offset(0, 4).Value = "#N/A"
 End If
Next

End Sub



Public Function FindMatch1(rTime As Range, rBnum As Range, rTime1 As Range, rBnum1 As Range)
Dim diff As Double, k As Long, i As Long, j As Long
Dim vt, vb, t, n, r As Range, s As String
vt = rTime1.Value
vb = rBnum1.Value
t = rTime
n = rBnum
j = -10
diff = CDbl(TimeValue("00:05:00"))
k = rBnum1.Row - 1
s = "Row: "
For i = LBound(vb, 1) To UBound(vb, 1)

If n = vb(i, 1) Then
  s = s & i + k & ", " & rTime1(i).Text & ", " & rBnum1(i).Offset(0, 1) & "| "
  Debug.Print s
  If Abs(vt(i, 1) - t) < diff Then
     j = i
     Exit For
  End If
End If
Next
If j >= 0 Then
 Set r = rBnum1(j).Offset(0, 1)
 FindMatch1 = r.Value
Else
  If Len(s) > 5 Then
    s = Left(s, Len(s) - 2)
    Debug.Print s
    FindMatch1 = s
  Else
    FindMatch1 = CVErr(xlErrNA)
  End If
End If
Debug.Print s
End Function




Option Explicit
Public Function FindMatch(rTime As Range, rBnum As Range, rTime1 As Range, rBnum1 As Range)
Dim diff As Double, k As Long, i As Long, j As Long
Dim vt, vb, t, n, r As Range
vt = rTime1.Value
vb = rBnum1.Value
t = rTime
n = rBnum
j = -10
diff = CDbl(TimeValue("00:05:00"))
k = rBnum1.Row - 1
For i = LBound(vb, 1) To UBound(vb, 1)

If n = vb(i, 1) Then
  If Abs(vt(i, 1) - t) < diff Then
     j = i
     Exit For
  End If
End If
Next
If j >= 0 Then
 Set r = rBnum1(j).Offset(0, 1)
 FindMatch = r.Value
Else
    FindMatch = CVErr(xlErrNA)
End If
End Function  

Answer
Hirok,

It isn't clear to which column the differential would be applied, but assume the right most column


Public Function FindMatch(rTime As Range, rBnum As Range, rTime1 As Range, rBnum1 As Range GMT as double)
Dim diff As Double, k As Long, i As Long, j As Long
Dim vt, vb, t, n, r As Range
vt = rTime1.Value
vb = rBnum1.Value
t = rTime
n = rBnum
j = -10
diff = CDbl(TimeValue("00:05:00"))
k = rBnum1.Row - 1
For i = LBound(vb, 1) To UBound(vb, 1)

If n = vb(i, 1) Then
 If Abs((vt(i, 1) + GMT) - t) < diff Then  '<== changed
    j = i
    Exit For
 End If
End If
Next
If j >= 0 Then
Set r = rBnum1(j).Offset(0, 1)
FindMatch = r.Value
Else
   FindMatch = CVErr(xlErrNA)
End If
End Function



If you want to apply it to the leftmost value (as single number then
you would not change that line.  You would change


t = rTime

to

t = rTime + GMT

--
Regards,
Tom Ogilvy