I would like to match workbook1 (A2) time to workbook2 (C4:C27) and return the value of row.
Workbook1
2:00 AM
Workbook2
12:00 AM
1:00 AM
2:00 AM
3:00 AM
4:00 AM
5:00 AM
6:00 AM
7:00 AM
8:00 AM
9:00 AM
10:00 AM
11:00 AM
12:00 PM
1:00 PM
2:00 PM
3:00 PM
4:00 PM
5:00 PM
6:00 PM
7:00 PM
8:00 PM
9:00 PM
10:00 PM
11:00 PM
Below is my code
Sub FindMatchingValue()
Dim i As Integer
Dim intValueToFind As String
Dim mypath As String
Dim wbkSource As Workbook
Dim tm As Range
Dim ctm As String
Set tm = ThisWorkbook.Worksheets(1).Range("A2")
mypath = "C:\Users\hlfoong\Desktop\Testing\"
fn = Dir(mypath & "pre*.xls")
Set wbkSource = Workbooks.Open(mypath & fn)
ctm = Format(tm, "h:mm AM/PM")
intValueToFind = ctm
'MsgBox ("time is " & ctm)
For i = 4 To 27
If Cells(i, 3).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
Exit Sub
End If
Next i
' This MsgBox will only show if the loop completes with no success
MsgBox ("Value not found in the range!")
End Sub
But it always return value not found. kindly help.
Related
Trying to Achieve
I fixed a date on my code say 31-01-2019. Then everyday I will execute my code but only on 28-02-2019/29-02-2020, 31-03-2019, 30-04-2019... I wish to execute the code. It is something like monthly generation. In addition, if the fixed date is 30-01-2019, I wish to execute the code on 28-02-2019/29-02-2020, 30-03-2019, 30-04-2019...
For example
What I have done
I have followed the question VBScript DateDiff month, and have tried out the following code but it is not working.
If I were to have a date say 31-Jan-2010 by DateAdd
endFeb = DateAdd("m",1,"31-Jan-10")
endMar = DateAdd("m",1,endFeb)
endApr = DateAdd("m",1,endMar)
The result
endFeb: 28/02/2010
endMar: 28/03/2010
endApr: 28/04/2010
What I want is
endFeb: 28/02/2010
endMar: 31/03/2010
endApr: 30/04/2010
Code
sFixedDate = "2019-01-31" '==== Fixed
sProcessDate = "2019-02-28" '==== Changes daily
d1 = CDate(sFixedDate)
d2 = CDate(sProcessDate)
diff = DateDiff("m", d1, d2)
If request("btnProcess") <> "" Then
If diff Mod 1 = 0 Then '=== Not as simple as I thought
'=== Trying to do monthly GENERATION.
'===Excecute the CODE
End If
End If
Basically, you want to run something on the last day of each month. Meaning that the day after would be a different month, so you could do something like this for calculating the last day of the next month:
today = Date
tomorrow = today + 1
If request("btnProcess") <> "" Then
If Month(today) <> Month(tomorrow) Then
endNextMonth = DateAdd("m", 1, tomorrow) - 1
End If
End If
To get the last day for any given month adjust the number of months to add to tomorrow's date.
The above assumes that you're doing the calculation on the last day of a month. If you want to calculate the last day of any given month on any day of a month please see Ekkehard Horner's answer.
Use DateSerial:
For m = 1 To 13
d1 = DateSerial(2019, m, 1) ' First day of month is easy
d2 = DateAdd("d", d1, -1) ' Last day of previous month is just 1 day before
WScript.Echo m, d1, d2
Next
cscript lom.vbs
1 01.01.2019 31.12.2018
2 01.02.2019 31.01.2019
3 01.03.2019 28.02.2019
4 01.04.2019 31.03.2019
5 01.05.2019 30.04.2019
6 01.06.2019 31.05.2019
7 01.07.2019 30.06.2019
8 01.08.2019 31.07.2019
9 01.09.2019 31.08.2019
10 01.10.2019 30.09.2019
11 01.11.2019 31.10.2019
12 01.12.2019 30.11.2019
13 01.01.2020 31.12.2019
It seems like for a given start date, you want to calculate x months into the future what that new date is, and if the start date as a day that is greater than the future month, to give the last day of the month instead.
Function CalculateFutureDate(startDate, monthsInFuture)
' Assumes startDate is in the past
Dim dtRepeatDate
Dim dtNewDate
If (IsDate(startDate)) Then
dtRepeatDate = CDate(startDate)
' months between now and Start Date
Dim intMonthsToAdd
Dim dtCurrentDate
dtCurrentDate = Now()
intMonthsToAdd = DateDiff("m", startDate, dtCurrentDate)
If intMonthsToAdd > 0 And Day(startDate) < Day(dtCurrentDate) Then
intMonthsToAdd = intMonthsToAdd - 1
End If
' Add the future months to the month offset
intMonthsToAdd = intMonthsToAdd + monthsInFuture
' Now calculate future date
dtNewDate = DateAdd("m", intMonthsToAdd, dtRepeatDate)
CalculateFutureDate = dtNewDate
End If
End Function
And then you can do something like:
CalculateFutureDate(CDate("2019-01-31"), intFutureMonths)
This will output:
?CalculateFutureDate(CDate("2019-01-31"), 1)
2/28/2019
?CalculateFutureDate(CDate("2019-01-31"), 2)
3/31/2019
?CalculateFutureDate(CDate("2019-01-31"), 3)
4/30/2019
dtLoan = CDate("2019-01-30")
dtProcess = CDate ("2020-02-28")
'dtLoan = CDate("2019-01-31")
'dtProcess = CDate ("2020-02-29")
'dtLoan = CDate("2019-02-28")
'dtProcess = CDate ("2020-02-29")
if LastDateOfMonth(dtLoan) = dtLoan AND dtProcess = LastDateOfMonth(dtProcess) then
response.write " this mean that the Loan date is end of the month, say 31 Jan, 28, 29 of Feb, 31 Feb "
response.write " and Process Date is also end of the month " & "<br>"
response.write " **** End of the month Loan Date : " & dtLoan & "<br>"
response.write " **** End of the month Process Date : " & dtProcess & "<br>"
elseif LastDateOfMonth(dtLoan) <> dtLoan AND dtProcess <> LastDateOfMonth(dtProcess) then
daysFromEndOfLoanMth = DateDiff("d",LastDateOfMonth(dtLoan),dtLoan)
response.write " How many days from end of Loan month: " & daysFromEndOfLoanMth & "<br>"
daysFromEndOfProcessMth = DateAdd("d",daysFromEndOfLoanMth,LastDateOfMonth(dtProcess))
response.write " From end of the month Add " & daysFromEndOfLoanMth & " Days = " & daysFromEndOfProcessMth & "<br>"
response.write " The date of process : " & dtProcess & "<br>"
dtShouldProcess = day(dtLoan) & "/" & Month(dtProcess) & "/" & Year(dtProcess)
if isDate(dtShouldProcess) then
dtShouldProcess=CDate(dtShouldProcess)
else
dtShouldProcess=daysFromEndOfProcessMth
end if
response.write " ** The date of should Process : ** " & dtShouldProcess & "<br>"
if dtProcess = dtShouldProcess then
'if dtProcess = daysFromEndOfProcessMth then
response.write " **** Loan Date : " & dtLoan & "<br>"
response.write " **** Process Date : " & dtProcess & "<br>"
end if
'daysFromEndOfProcessMth = DateDiff("d",LastDateOfMonth(dtProcess1),dtProcess1)
'response.write " How many days from Process Date end of the month: " & daysFromEndOfProcessMth & "<br>"
end if
I have the following problem
In a given range for example 1 Jan 2017 to 31 Jan 2017,
How many days of the following range events period occurred?
Example
1 range 1 Dec 2016 / 30 Jun 2017 = 31
2 range 1 Jan 2017 / 2 Jan 2017 = 2
3 range 4 Aug 2017 / 31 Aug 2017 = 0
4 range 24 Sep 2015 / 2 Jan 2017 = 2
5 range 6 Jan 2015 / 6 Feb 2016 = 0
Do you have some idea for an algorithm in access-VBA?
Many thanks
Public Function DaysInRange(vntRngStart As Date, vntRngEnd As Date, vntTestStart As Date, vntTestEnd As Date) As Integer
On Error GoTo PROC_ERR
Dim vntOverlapStart As Date
Dim vntOverlapEnd As Date
If vntRngStart > vntRngEnd Then
MsgBox "Main date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
DaysInRange = -1
Exit Function
ElseIf vntTestStart > vntTestEnd Then
MsgBox "Test date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
DaysInRange = -2
Exit Function
End If
If vntTestEnd < vntRngStart Or vntTestStart > vntRngEnd Then
'Either your test range ends before the given range starts,
'or the test range starts after the end of the given range,
'so there is no overlap between the two ranges.
DaysInRange = 0
Exit Function
End If
'So now we know that there must be some overlap
If vntTestStart <= vntRngStart Then
'Our test range starts before the start of the given range,
'so the overlap starts at the beginning of the given range
vntOverlapStart = vntRngStart
Else
'Our test range starts after the start of the given range,
'so the overlap starts at the beginning of the test range
vntOverlapStart = vntTestStart
End If
If vntTestEnd >= vntRngEnd Then
'Our test range ends after the end of the given range,
'so the overlap ends at the end of the given range
vntOverlapEnd = vntRngEnd
Else
'Our test range ends after the end of the given range,
'so the overlap ends at the end of the test range
vntOverlapEnd = vntTestEnd
End If
DaysInRange = DateDiff("d", vntOverlapStart, vntOverlapEnd) + 1
PROC_EXIT:
On Error Resume Next
Exit Function
PROC_ERR:
MsgBox "Error " & Err.Number & " in Function 'DaysInRange': " & Err.Description
Resume PROC_EXIT
End Function
I have these records on my Day Table name tblday
M
T
W
TH
F
S
MW
TTH
WF
Let say if I have this existing schedule:
ScheduleID = 10001
StartTime = 8:30 AM
EndTime = 1:00 PM
Day = M
Room = AVR
Course = BSN
Then If I add this new entry
ScheduleID = 10002
StartTime = 9:00 AM
EndTime = 10:00 AM
Day = MW
Room = AVR
Course = BSN
This should prompt a conflict in schedule because there is already a schedule for monday, then the new entry shouldn't be added. : )
Note: MW means 'Monday' AND 'Wednesday', I used this if they have both the same schedule. Because it would become redundant if add a new schedule for monday and add another for thursday with the same day, time, room and course. Also the same as TTH and MWF I can only detect conflict if it is not a combination of both Days (e.g MTH, TF, ...) I really spend a lot of time regarding this issue. Please I really need your help : (
Heres the code:
Function RoomInUse() As Boolean<br><br>
Dim room As String<br>
Dim day As String<br>
Dim starttime As Date<br>
Dim endtime As Date<br>
Dim mond As String<br>
Set rs = New ADODB.Recordset<br>
With rs<br>
mond = "select * from tblsched where room Like '" & room & "%' and day like '" & room & "' and (starttime <= #" & starttime & "# And " & _<br>
"endtime >= #" & starttime & "#) Or (#" & starttime & "#" & _<br>
"<= starttime And endtime < #" & endtime & "#) Or (#" & _<br>
starttime & "# <= sarttime And starttime < #" & endtime & "#)) " '"<br>
.Open mond, con, 3, 3<br>
End With
If rs.RecordCount >= 1 Then
RoomInUse = True
Else
RoomInUse = False
End If
End Function
Im using visual basic 6.0
Im trying to auto fill my form. text9.text as date of registration and text10.text and expiration date.
I want to add 1 year to text3.text:
Format$(Now, ", mmmm dd, yyyy") the output will be LIKE THIS FOR EXAMPLE: December 15, 2013 (THIS IS THE DATE TODAY) on text2.text
Is there any way I can produce an uotput of: December 15, 2014 into a textbox10.text in the same form as text9.text ?
This the code im using:
Private Sub Form_Load()
Call connect
query = "Select * from Taxi"
rsglob.Open query, connglob
If rsglob.BOF = True Then
Exit Sub
Else
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = Format$(Now, "mmmm dd, yyyy") (out put is: December 15, 2013)
Text10.Text = Format$(Now, ", mmmm dd, yyyy") (Is there any way I make it here as: ( December 15, 2014) ?
End If
Call Gen_ID(Text1)
End Sub
Use the DateAdd function
http://www.vb6.us/tutorials/understanding-vb6s-dateadd-function
DateAdd("yyyy", 1, Now)
Text10.Text = Format$(DateAdd("yyyy", 1, Now), ", mmmm dd, yyyy")
[Part 1 - Original question]
I have values like 30, 31, 28 or 29 which are total days of the month.
I want to make a for loop
If I select 28 it should display a msgbox 28 times.
If I select 31 it should display a msgbox 31 times.
The code I tried:
Dim dayst As Variant
Dim tot1 As Variant
tot1 = DateDiff("d", "01/2011", DateAdd("m", 1, "01/2011"))
tot1 = Split(tot1, ",")
For Each dayst In tot1
MsgBox dayst
Next
The above code is showing "31" in the msgbox, instead of 31 times like "1", "2", ... "31"
I want to display a msgbox 31 times incrementing from 1 to 31.
[Part 2 - Updated request]
Default Column Value Example
ID 1 2 ..... 31 totaldays
001 Yes Yes .... Yes 31
002 Yes Yes .... Yes 31
003 Yes Yes .... Yes 31
.....
001 is coming from table
Yes is the default column value for 1 to 31 or 1 to 28
totaldays should be no of days permonth.
How can I accomplish this using vb6.
You could just use a simple loop like this - although I dont see why you would want to have 28-31 MsgBox prompts in a row
Dim tot1 As Long
Dim lngDays As Long
tot1 = DateDiff("d", "01/2011", DateAdd("m", 1, "01/2011"))
For lngDays = 1 To tot1
MsgBox lngDays
Next
Updated version - adds early exit option
Dim tot1 As Long
Dim lngDays As Long
Dim lngExit As Long
tot1 = DateDiff("d", "01/2011", DateAdd("m", 1, "01/2011"))
For lngDays = 1 To tot1
lngExit = MsgBox(lngDays, vbOKCancel, "Press Cancel to exit")
If lngExit = vbCancel Then Exit Sub
Next