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)
Related
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:
Working on populating a row in excel with dates between a start date and current date. The population is weekly and below is the function I have made. It works fine up until the point where it doesn't stop but continues to go infinitely until there is an overflow error hence my assumption is that CurrentDate is not working properly.
The 2 dates used are StartDate = 04/1/2016 and CurrentDate = 12/07/2017.
Any help or suggestions would be greatly appreciated.
Public Function PopulateStartOfWeekDates()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim StartDate As Date
Dim CurrentDate As Date
StartDate = FirstMondayOfYear()
CurrentDate = Date
Dim WeekOffset As Integer
Dim i As Integer
i = 12
WeekOffset = 0
Debug.Print StartDate
Debug.Print CurrentDate
Do While StartDate < CurrentDate
wsCRC.Cells(5, i) = StartDate + WeekOffset
wsCRC.Cells(5, i).EntireColumn.AutoFit
i = i + 1
WeekOffset = WeekOffset + 7
Loop
End Function
If you decide you need to maintain the value of StartDate (e.g. to use later in the code), you could replace your loop with:
i = 0
Do While StartDate + i * 7 < CurrentDate
wsCRC.Cells(5, i + 12) = StartDate + i * 7
wsCRC.Cells(5, i + 12).EntireColumn.AutoFit
i = i + 1
Loop
After looking at this myself I realized I wasn't increasing the startdate hence the loop was infinite. Thanks to #Nathan_Sav for pointing this out in the comments too.
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
I currently have a spreadsheet with pre written dates in order in a dd/mm/yyyy format, but i want to be able to change the entire sheet so that when i select a month from a drop down list it changes all the dates so they stay starting at the 1st through to the 31st, but only the month changes, using visual basic. I can use this to set specific dates,
Range("C3") = Format(DateSerial(Year:=2005, Month:=2, Day:=3), "mm-dd-yyyy")
But can i change just the month using something like this for example
Range("C3") = Format(DateSerial(Month:=5), "mm-dd-yyyy")
You could do something like this:
Function MakeDates(startDate As Date) As Date()
Dim myDates() As Date, myYear As Integer, myMonth As Integer, daysInMonth As Integer
Dim firstOfMonth As Date, firstOfNextMonth As Date, d As Integer
myYear = Year(startDate)
myMonth = Month(startDate)
firstOfMonth = DateSerial(myYear, myMonth, 1)
firstOfNextMonth = DateSerial(myYear, myMonth + 1, 1)
daysInMonth = DateDiff("d", firstOfMonth, firstOfNextMonth)
ReDim myDates(daysInMonth - 1)
For d = 1 To daysInMonth
myDates(d - 1) = DateSerial(myYear, myMonth, d)
Next d
MakeDates = myDates
End Function
Then you can call it like this
Dim d
d = MakeDates(#2/1/2014#)
Range("A1").Resize(rowsize:=31).Value = ""
Range("A1").Resize(rowsize:=UBound(d) + 1) = WorksheetFunction.Transpose(d)
That second to last line will remove the excess dates for you.
You should have your range formatted as a date. You can do that in code or just do it once in Excel. The latter is probably easier.
If i have a string containing a date formatted like this:
1402-3
which means Year: 2014, Week: 02 and Day number 3 (monday is 1), how can i convert this to a normal date? (in this case the date above is today; 2014-01-08 - wednesday 8 jan 2014)
Edit: I came up with a function like this, can anyone tell if this is gonna fail or maybe have a better and better coded function/solution?
Private Function StrangeFormattedDateToRegularDate(ByVal StrangeDate As String) As Date
Dim Y As String = "20" & StrangeDate.Substring(0, 2) 'I'll be dead before this fails, haters gonna hate
Dim W As String = StrangeDate.Substring(2, 2)
Dim D As String = StrangeDate.Substring(5, 1)
'Get first day of this year
Dim RefDate As Date = New Date(CInt(Y), 1, 1)
'Get the first day of this week (can be the year before)
Dim daysOffSet As Integer = DayOfWeek.Monday - RefDate.DayOfWeek
RefDate = RefDate.AddDays(daysOffSet)
'Add as many days as the weeks is
RefDate = RefDate.AddDays(7 * CInt(W))
'now the date is the last day of this week (plus one day), remove the days that are ahead, and remove that extra day
Dim daysToRemove = ((7 - CInt(D)) * -1) - 1
RefDate = RefDate.AddDays(daysToRemove)
Return RefDate
End Function
This should be what you're looking for :) This looked challenging so I tried it. Tell me if it works for you or not :)
Function GetDate(InputDate As String) As DateTime
Dim FirstDayofYear As Date = CType("1/1/20" & Mid(InputDate, 1, 2), Date)
Dim LastDayofYear As Date = CType("12/31/20" & Mid(InputDate, 1, 2), Date)
Dim target As Date
For x = 0 To DateDiff(DateInterval.Day, FirstDayofYear, LastDayofYear)
Dim dfi = DateTimeFormatInfo.CurrentInfo
Dim calendar = dfi.Calendar
Dim weekOfyear = calendar.GetWeekOfYear(FirstDayofYear.AddDays(x), dfi.CalendarWeekRule, DayOfWeek.Sunday)
If CInt(Mid(InputDate, 3, 2)) = weekOfyear And CInt(Mid(InputDate, InStr(InputDate, "-") + 1)) = FirstDayofYear.AddDays(x).DayOfWeek Then
target = FirstDayofYear.AddDays(x)
GoTo skip
End If
Next x
skip:
Return target
End Function
This works up to Year 2099. We're probably all dead by then.