I have a date in cell A1 in text format - May 18
Using VBA, is it possible, to positively compare this value to the value in cell A2 - 01/05/2018 (UK date format)?
I've tried using the CDate function, but it does not return the correct value. For example, If the value in A1 was Nov 24, CDate reurns 24/11/2018.
So, what I want to do is :-
If A1 = May 18
AND A2 = 01/05/2018
THEN TRUE
You could use DATEVALUE:
=DATEVALUE("1 " & $A$1)=$A$2
Will return TRUE if 1st of the month in cell A1 is the same as the date in cell A2.
You can use an Excel formula:
=TEXT("18 May","dd-mm-yyyy")
Or in VBA:
Dim Dt As Date
Dt = CDate(Range("A1"))
Dim Compare As Boolean
Compare = Dt = Range("A2")
With VBA, consider:
Sub DateCompaison()
Dim s1 As String, s2 As String, d2 As Date
s1 = [A1].Text
s2 = [A2].Text
arry1 = Split(s1, " ")
arry2 = Split(s2, "/")
month1 = arry1(0)
year1 = "20" & arry1(1)
d2 = DateSerial(CInt(arry2(2)), CInt(arry2(1)), CInt(arry2(0)))
month2 = Format(d2, "mmmm")
year2 = CStr(Year(d2))
If month1 = month2 And year1 = year2 Then
MsgBox "the same"
Else
MsgBox "not the same"
End If
End Sub
Related
How do i convert day/Month to Julian Day in visual basic?
Formula for converting in other languages are also appreciated.
For e.g
Julian Day for 1 Feb=032
https://landweb.modaps.eosdis.nasa.gov/browse/calendar.html
From research in the web ,most resolutions are converting the date with yyyy-mm-dd to julian date.
As the example above, i need to get value 032
The .Net JulianCalendar Class exposes all methods needed to achieve your goal. It is also COM visible, so you can reference it in a VBA project after adding a project reference to "mscorlib.dll".
In VB.Net the code would be:
Dim jc As New System.Globalization.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As DateTime = jc.ToDateTime(2018, 2, 1, 0, 0, 0, 0)
' = #2/14/2018 12:00:00 AM#
Dim dayOfYear As Int32 = jc.GetDayOfYear(gregoriaDateEquivalent)
' = 32
In VBA the code would be:
Dim jc As mscorlib.JulianCalendar
Set jc = New mscorlib.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As Date
gregoriaDateEquivalent = jc.ToDateTime(2018, 2, 1, 0, 0, 0, 0)
' = #2/14/2018
Dim dayOfYear As Long
dayOfYear = jc.GetDayOfYear(gregoriaDateEquivalent)
' = 32
First you have to add reference to mscorlib library
Under VB6,Project-References->Tick the mscorlib checkbox
Create this function method in the object that you ahve or otherwise create a sub procedure
Public Function JulianConverter() As String
'MsgBox Fix(5.2), vbExclamation, App.Title
'MsgBox Fix(5.6)
Dim y As String
Dim m As String
Dim d As String
Dim strDate As String
Dim dateArray() As String
strDate = Format(Now, "dd/MMM/yyyy")
dateArray = Split(strDate, "/")
d = dateArray(0)
m = dateArray(1)
y = dateArray(2)
'Debug
'MsgBox strDate
'Convert to Integer
y = Val(y)
m = Val(m)
d = Val(d)
If m <= 2 Then
y = y - 1
m = m + 12
End If
'Dim A As Double
' Dim B As Double
'Dim JD As Double
' A = CDbl(Fix(y / 100#))
'B = 2 - A + Fix(A / 4)
'JD = Fix(365.25 * (y + 4716)) + Fix(30.6001 * (m + 1)) + d + B - 1524.5
'JulianConverter = CStr(JD) 'Convert to string
Dim jc As mscorlib.JulianCalendar
Set jc = New mscorlib.JulianCalendar
' create a gregorian equivalent of the julian date: 1 Feb 2018
Dim gregoriaDateEquivalent As Date
gregoriaDateEquivalent = jc.ToDateTime(2018, m, d, 0, 0, 0, 0)
' = #2/14/2018
Dim dayOfYear As Long
Dim dayOfYearS As String
Dim digitLength As Integer
Dim Counter As Integer
dayOfYear = jc.GetDayOfYear(gregoriaDateEquivalent)
'Have to ensure 3 digits values
dayOfYearS = CStr(dayOfYear)
'Count number of Digits of string
digitLength = Len(dayOfYearS)
MsgBox "DigitLength" & digitLength, vbExclamation, App.Title
'If Digits length smaller than 3,add one 0 in front
If (digitLength < 3) Then
dayOfYearS = "0" & dayOfYearS
End If
JulianConverter = dayOfYearS
End Function
This will ensure the julian day will be 3 digits in value based on the current system date
All,
I have written a little procedure which I would like a for each loop to insert the current month into the first cell "01"/MM/YY and then add one month to the date as it goes through the loop. Using the example below;
K1 = 01/06/2018
L1 = 01/07/2018
M1 = 01/08/2018 etc
The code I am using is below - The error is on the DateAdd line.
Sub test()
Dim dt As date
dt = "01/" & Application.Text(Now(), "MM/YY")
Dim i As Double
i = 1
For Each c In Range("K1:XFD1")
If c.Value = "" Then Exit For
c.Value = dt
'change date to one months time
dt = DateAdd(m, i, dt)
i = i + 1
Next c
End Sub
Any help regarding this would be much appreciated.
Put "m" not m. m would be a variable. "m" is a literal string representing the argument being "month".
dt = DateAdd("m", i, dt)
I have 2 tables, Table 1 and Table 2. Both the tables have one date column each. I am inserting the first Monday of the month on top of the table 1 and Table 2, both. I will fetch date value from each row of the table 2, and if it is more than the value on top of the table, I will insert 0. If the date value in the table 2 is "16/02/2018", and it is not a Monday, I will insert the Monday after it, and the value 1 for that record.How can I proceed with it? Please help.
Dim col_tab2_dat as Date
first_day = DateSerial(Year(Date), Month(Date), 1)
last_day = DateSerial(Year(Date), Month(Date) + 1, 1)
curr_month= Format(first_day, "mmm")
w = Weekday(first_day , vbMonday)
FirstMonday = first_day + IIf(w <> 1, 8 - w, 0)
tab1_last_lin = ws.Columns(2).Find("Total(T1)").Row
tab2_last_lin = ws.Columns(2).Find("Total(T2)").Row
find_tab2 = ws.Columns(1).Find("Table 2").Row
last_lin = Range("B" & Rows.Count).End(xlUp).Row
last_col_tab1 = ws.Cells(tab1_last_lin, ws.Columns.Count).End(xlToLeft).Column
last_col_tab2 = ws.Cells(tab2_last_lin, ws.Columns.Count).End(xlToLeft).Column
last_dat = ws.Cells(2, last_col_tab1 - 1).Value
new_date = last_dat + 7
For i = find_tab2 + 3 to tab2_last_lin
ws.Cells(find_tab2 + 3, 1).Value = col_tab2_dat
If col_tab2_dat > last_dat Then
I am stuck here. What to do next?
End If
Next i
Here is a function that will return the next Monday:
Public Function GetNextMonday(dt As Date) As Date
Do Until Weekday(dt, vbSunday) = 2
dt = DateAdd("d", 1, dt)
Loop
GetNextMonday = dt
End Function
Here's a function that will work for any day of the week.
NextWeekday Function:
Function NextWeekday(FromDate As Date, vbWeekday As VbDayOfWeek) As Date
If Weekday(FromDate) < vbWeekday Then
NextWeekday = FromDate + vbWeekday - Weekday(FromDate)
Else
NextWeekday = FromDate + 7 + vbWeekday - Weekday(FromDate)
End If
End Function
It takes two arguments:
FromDate: The Date of which you are wanting to find the next weekday of. You can simply use "Date" as the argument for today's Date.
vbWeekday: The upcoming day of the week you are wanting the date for.
VBA Example:
Once you've added the above function to your code module, it's easy to get its value:
Sub Main()
Dim NextThursday As Date
NextThursday = NextWeekday(Date, vbThursday)
End Sub
Worksheet Formula Example:
Or you can use it as a worksheet function:
=NextWeekday(Today(), 5)
Worksheet Formula Considerations:
Notice in the worksheet formula we had to remove the vbThursday constant as worksheet functions doesn't have this functionality built-in. However, if you want to still use these constant values in your worksheet, you can create them yourself by using the Name Manager.
Click on the Formulas Tab, then on Define Name
Start creating your constants starting at vbSunday = 1 through vbSaturday = 7 by placing the Constant Name in the Name: field, and the value in the Refers to: field:
And there you have it! You can now refer to them using your named values:
Additional Example Usage:
Comments:
The benefit of using the VbDayOfWeek Type is that you will now gain IntelliSense when using the function:
I have infinite rows with with a single column assigned to define date and time in the following 'General Format' "2016.08.10 06:00:00.066". I am aware that you can't convert every single cell in this column "mm/dd/yyyy hh:mm:ss.000 AM/PM". Therefore I would a single column assigned to "mm/dd/yyyy" and another column assigned to "hh:mm:ss.000 AM/PM". The time is currently 6 hours behind as well so I would like to add 6 hours to it.
I am struggling with this as although the cells are in general or text format the time and date is being displayed as "yyyy.mm.dd hh:mm:ss.000". And can't find a way to split the two in this format
Any help is appreciated
To convert the text to a format that Excel will change to a data/time use this:
=--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1)
Then to add 6 hours you would use:
+ TIME(6,0,0)
So to get the date/time is:
=--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0)
Then simply format the new cell:
mm/dd/yyyy hh:mm:ss.000 AM/PM
You can also split it into the date and time:
Date:
=INT(--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0))
And format it mm/dd/yyyy
Time:
=MOD(--SUBSTITUTE(SUBSTITUTE(A1,".","/",1),".","/",1) + TIME(6,0,0)),1)
And format it hh:mm:ss.000 AM/PM
use text: =concatenate(text(a1,"MM"),text(a1,"DD"),text(a1,"YYYY") do the same for the other column =concatenate(text(a1,"HH"),text(a1,"MM"),text(a1,"SS")
That's pretty strange that you Excel will round off the milliseconds if you try and use a Date-Time format.
Enum DTValues
ReturnDate
ReturnTime
ReturnDateTime
End Enum
Function getDateTime(yyyymmdd_hh_mm_ss_000 As String, ReturnValue As DTValues) As Single
Dim arr
Dim mSecs As Single
yyyymmdd_hh_mm_ss_000 = Replace(yyyymmdd_hh_mm_ss_000, " ", ".")
yyyymmdd_hh_mm_ss_000 = Replace(yyyymmdd_hh_mm_ss_000, ":", ".")
arr = Split(yyyymmdd_hh_mm_ss_000, ".")
mSecs = arr(6) / 24 / 60 / 60 / 100
Select Case ReturnValue
Case ReturnDate
getDateTime = CSng(DateSerial(arr(0), arr(1), arr(2)))
Case ReturnTime
getDateTime = CSng(TimeSerial(arr(3), arr(4), arr(5))) + mSecs
Case ReturnDateTime
getDateTime = CSng(DateSerial(arr(0), arr(1), arr(2))) + CSng(TimeSerial(arr(3), arr(4), arr(5))) + mSecs
End Select
End Function
Sub ProcessDates()
Const WORKSHEET_NAME = "Sheet1"
Const FIRST_ROW = 2
Const SOURE_COLUMN = 1
Const DATE_COLUMN = 2
Const TIME_COLUMN = 3
Dim Target As Range
Dim arDate, arTime
Dim y As Long
With Worksheets(WORKSHEET_NAME)
Set Target = .Range(.Cells(FIRST_ROW, SOURE_COLUMN), .Cells(Rows.Count, SOURE_COLUMN).End(xlUp))
End With
arDate = Target.Value
arTime = Target.Value
For y = 1 To UBound(arDate)
arDate(y) = getDateTime(arDate(y), ReturnDate)
arTime(y) = getDateTime(arTime(y), ReturnTime)
Next
Target.EntireRow.Columns(DATE_COLUMN).Value = arDate
Target.EntireRow.Columns(TIME_COLUMN).Value = arTime
End Sub
This is my first time coding from scratch and a very dumb question indeed.
Why do i keep getting this error?
Runtime Error '13' : Type mismatch
My value in B1 is an integer
Private Sub Workbook_Open()
xdate = Worksheets("sheet1").Range("A1")
lsdate = DateAdd("d", -7, Date)
'MsgBox lsdate
If Day(lsdate) > Day(xdate) Then
Worksheets("sheet1").Range ("B1") * 1 = result
Else
Worksheets("sheet1").Range ("B1") * 1.07 = result
End If
Range("c1").Value = result
End Sub
I have further edit my code to the following but not able to get the condition to work
'To create the following condition
'If less than 7 days interest = 0%
'if 8 to 30 days interest = 7%
'if more than 31 days interest = 9%
Sub Workbook_Open()
For i = 1 To 3 'Rows.Count
xdate = Cells(i, 1)
'MsgBox Cells(i, 1)
nulldate = DateAdd("d", -7, Date)
irate7late = DateAdd("d", -8, Date)
irate7early = DateAdd("d", -30, Date)
If Day(nulldate) < Day(xdate) Then
result = Cells(i, 2) * 1
ElseIf Day(irate7early) <= Day(xdate) And Day(xdate) <= Day(irate7late) Then
'30/9/2015 20/10/2015 20/10/2015 22/10/2015
result = Cells(i, 2) * 1.07
ElseIf Day(irate7early) > Day(xdate) Then
result = Cells(i, 2) * 1.09
End If
Cells(i, 3).Value = result
Next i
End Sub
You seem pretty new at programming, so I'll explain plainly :
When you are trying to assign a value to a variable in almost every language, you use :
variable = value
So you can do a lot of operations on the value, which is on the right of the equals =.
BUT you canNOT do operations on the left of the equals = when you simply assigning a value to a variable. You can do almost any operations when you are testing 2 variables but you'll have a keyword like If or While at the start of the line of code.
So the issue with your code is that you reversed the order of the value and the variable and tried to do value * 1 = variable
Here is your corrected code (I indented it so that it can be read easily) :
Private Sub Workbook_Open()
xdate = Worksheets("sheet1").Range("A1")
lsdate = DateAdd("d", -7, Date)
'MsgBox lsdate
If Day(lsdate) > Day(xdate) Then
result = Worksheets("sheet1").Range ("B1") * 1
Else
result = Worksheets("sheet1").Range ("B1") * 1.07
End If
Sheets("Sheet_name").Range("c1").Value = result
End Sub
And you should always reference the sheet you are working with, because previously, your code didn't specify on which sheet the C1 was supposed to be.
So here, just change Sheet_name to whatever the name of your sheet is!
variables need to get the values from sheet. You are trying opposite way which is why you getting error.
Private Sub Workbook_Open()
xdate = Worksheets("sheet1").Range("A1")
lsdate = DateAdd("d", -7, Date)
'MsgBox lsdate
If Day(lsdate) > Day(xdate) Then
result = Worksheets("sheet1").Range("B1") * 1
Else
result = Worksheets("sheet1").Range("B1") * 1.07
End If
Range("c1").Value = result
End Sub
Sub test1()
Dim var1 As Variant
' If you need to get values from the range("D1") Then use the below code
var1 = Worksheets("sheet1").Range("D1").Value
End Sub