I want to run a code that transfers data from one sheet to another based on the year (eg 01/01/2018 - 31/1/2018).
The sheet contains 2 columns with dates, start_date and end_date stored as dates, so I did an If statement but it doesn't seem to "understand" the dates values that I stored previously.
'Dates columns
Dim fechaIniTarget As Variant
Dim fechaFinTarget As Variant
'Ini = start / Fin = end
Set fechaIniTarget = Range("D2")
Set fechaFinTarget = Range("E2")
If fechaIniTarget.Value = "01/01/2018" And fechaFinTarget.Value = "31/12/2018" Then
' function
MsgBox "PROCESO COMPLETO"
End If
I tried parsing the dates as integer but it still doesn't work.
You compare a date fechaIniTarget.Value against a string "01/01/2018". Use a real date with the DateSerial function instead to compare date against date.
If fechaIniTarget.Value = DateSerial(2018, 1, 1) And fechaFinTarget.Value = DateSerial(2018, 12, 31) Then
Also note that you used 2 times fechaIniTarget but I guess the second one should be fechaFinTarget.
Also don't use Variant if not necessary. Instead declare your variables As Range here:
Dim fechaIniTarget As Range
Dim fechaFinTarget As Range
Related
I have a data field that is on the worksheet as a custom number format
geo:
[![![data column example][1]][1]
sum:[![![data column example][2]][2]
I am taking that field and comparing it to wo other fields on another worksheet to determine if this one is in between those. So I've got the below code that uses variants for the arrays and splits along spaces. I think the best way is to use the datevalue and timevalue functions with inequalities, both of which take strings. any ideas why I'm getting a type mismatch error at the split?
UPDATE: Based on the #### comment, and the column reference mistake, I autosized the dateTime co and changed my column references. Now my sumfull string gets the text of the column. I am still getting a type match error on the next line. I've updated the code below. The code breaks at sumsplit = Split(sumfull, " ") with a Type mismatch error. The contents of .Cells(i.row, 4).text is "01/23/2022 18:53". This is also the value of sumfill when it breaks.
Option Explicit
Sub O_face()
Dim geo As Workbook
Dim sum As Workbook
Dim geowks As Worksheet
Dim sumwks As Worksheet
Dim i As Variant
Dim j As Variant
Dim lastrow As Long
Dim georng As Range
Dim sumrng As Range
Dim geofull As Date
Dim sumfull As Date
Dim sumfull2 As Date
Set geo = ThisWorkbook
Set sum = Workbooks.Open("MyFile.csv")
Set geowks = geo.Workshets(1)
geowks.Range("B:B").EntireColumn.AutoFit
Set sumwks = sum.Worksheets(1)
sumwks.Range("F:G").EntireColumn.AutoFit
lastrow = geowks.Cells(Rows.Count, "a").End(xlUp).Row
geowks.AutoFilterMode = False
geowks.Range("A1:L" & lastrow).AutoFilter Field:=5, Criteria1:="<>", Operator:=xlFilterValues
Set georng = geowks.Range("E2:E" & lastrow).SpecialCells(xlCellTypeVisible)
lastrow = sumwks.Cells(Rows.Count, "a").End(xlUp).Row
sumwks.AutoFilterMode = False
sumwks.Range("A1:P" & lastrow).AutoFilter Field:=3, Criteria1:="<>", Operator:=xlFilterValues
Set sumrng = sumwks.Range("C2:C" & lastrow).SpecialCells(xlCellTypeVisible)
'have to split the date time cell because it's a custome data type in the worksheet. Then compare the date and time seperately.....
For i = 1 To sumrng.Rows.Count
sumfull = sumrng.Cells(i, 4)
sumfull2 = sumrng.Cells(i, 5)
For j = 1 To georng.Rows.Count
geofull = georng.Cells(j, -2)
If sumrng(i, 1) = georng(j, 1) And _
geofull >= sumfull And geofull >= sumfull2 Then
sumrng.Cells(i, 15) = "IS THIS WHAT YOU WANT!!!!"
End If
End If
Next j
Next i
End Sub
(a)
Split returns an array of strings. You can assign the result to a dynamic String-Array or to a Variant-Variable, see https://stackoverflow.com/a/57113178/7599798 . What you try to do is assign it to a Variant Array - this will fail. You also don't need to set the dimensions of that array, split will take care about that anyhow. So that would be:
Dim sumsplit() As String
sumfull = CStr(sumrng.Cells(i.Row, "f").Text)
sumsplit = Split(sumfull)
(b)
Assuming that your data in Excel are Dates (not Strings that look like a Date), there is neither a reason to convert them to a string nor split that string to get the date and time part. Just use Date variables. In the background, Dates are Floating point Numbers (=Double). The number before the decimal defines the Date-Part (Days since 31.12.1899), the remainder the Time. To get Date and Time of an Excel-Date:
Dim sumfull As Date, fsumdate As Date, fsumtime As Date
sumfull = sumrng.Cells(i.Row, "f").value
fsumdate = int(sumfull) ' Remove the digits after the decimal
fsumtime = sumFull-int(sumfull) ' The digits after the decimal is the Time.
(c) I don't fully understand the logic of your If-statement, but you can simply compare date variables with < and > - a higher number means a later date/time. I assume that you will not need to compare date and time parts separately. Probably this will do:
Dim geoDate As Date, fsumDate As Date, lSumDate As Date
fsumDate = sumrng.Cells(i.Row, "f").value
lsumDate = sumrng.Cells(i.Row, "g").value
geoDate = georng.Cells(j.Row, "b").value
If geodate >= fsumdate And geodate <= lsumdate Then
(d)
Generally, you should avoid using the Text-property. If for any reason the width of a cell is too small to display the date, Excel will display "######" instead - and you will get exact this into your program.
I am trying to build a VBA code where I am given 2 dates to be used as a date range. Using this date range, I am trying to compare it to a date in every row within a table. If the table date is within the date range, I want to retrieve a specific value also within the table.
Example:
Date Range:
02/01/2021 - 07/01/2021
The colors are in Column A and the dates are in column B
Red - 03/08/2021
Orange - 09/01/2021
For this example, I need it to return "Red"
Yes there is...
If you try it, remember to first set the correct values on the CONFIG sections of the code.
Sub RetrieveValue()
Dim start_date, end_date As Date
Dim dates_col, db_start_row, db_end_row As Integer
Dim counter, values_col, retrieve_values_col As Integer
'CONFIG THIS BEFORE YOU RUN THE MACRO
'--------------------------
retrieve_values_col = 4 'column number where you want to retrieve the values
values_col = 2 'column where all the values are
dates_col = 3 'in what column are the dates?
db_start_row = 3 'in what row does the data start?
start_date = Date - 4 'set the date interval
end_date = Date + 3 'DATE is a function that returns todays date
'--------------------------
db_end_row = Cells(Rows.Count, dates_col).End(xlUp).Row
For counter = db_start_row To db_end_row
If Cells(counter, dates_col) >= _
start_date And Cells(counter, dates_col) <= end_date Then
Cells(counter, retrieve_values_col) = Cells(counter, values_col)
End If
Next counter
End Sub
The dates must be set like in the following picture for the macro to work.
Guys my primary objective is to avoid invalid days.
In sheet 1 i have:
A1 data validation with years (from 1900-2019)
B1 data validation with all months
C1 i use change event (if both fields A1 & A2 are not empty) calculate how many days the selected month has based on the selected year and create a data validation includes all available days.
For days calculation i use:
Option Explicit
Sub test()
Dim ndays As Long
With ThisWorkbook.Worksheets("Sheet1")
ndays = Day(DateSerial(.Range("A1").Value, .Range("B1").Value + 1, 1) - 1)
End With
End Sub
Sheet Structure:
Is there a batter way to calculate days?
you could use:
DateValue() function to build a date out of a string you compose with your year and month values and adding any valid day number (I chose "1" to be sure...)
EOMONTH() worksheet function to get the last day of the resulting date month:
like follows:
With someSheet
...
nb_days = Day(WorksheetFunction.EoMonth(DateValue(.Range("A1").Value & " " & .Range("B1").Value & " 1"), 0))
...
End With
I suggest to use the UDF (User Defined Function) below.
Function MonthDays(Rng As Range) As Integer
Const Y As Integer = 1
Const M As Integer = 2
Dim Arr As Variant
Application.Volatile ' recalculates on every change
If Application.WorksheetFunction.Count(Rng) = 2 Then
Arr = Rng.Value
MonthDays = DateDiff("d", DateSerial(Arr(Y, 1), Arr(M, 1), 1), _
DateSerial(Arr(Y, 1), Arr(M, 1) + 1, 1))
End If
End Function
You can call it directly from the worksheet with a function call like =MonthDays(A1:A2) where A1 holds the year and A2 holds the month. If either is missing the function returns 0. The function accepts impossible numbers for both year and month and will return a logical result, such as the 14th month of a year being the following year's February. However, you can limit the entries by data validation.
All UDFs can be called as normal functions from your code. Cells(3, 1).Value = MonthDays(Range("A1:A2")) would have the same effect as entering the function call as described in the preceding paragraph in A3. However, if the function is called from VBA the line Application.Volatile would be not required (ineffective).
EDIT: Based on answers I was able to get min/max date from a range:
Dim dt As Date
dt = WorksheetFunction.Min(Range("D2:D300"))
But it's not enough. How do I use this function with an array instead of a range?
Original post:
I have the following columns:
The format is: DD/MM/YYYY HH:MM
I'm trying to get the soonest datetime from column one and the latest datetime from column two. In this case:
02/01/2017 6:07 (earlist datetime from the first column, 2nd of January)
02/02/2017 14:11 (latest datetime from the second column, 2nd of February)
I have a multidimensional array (myData) with the values from the cells and my functions are these ones:
Private Function GetLatestDateFromData() As String
Dim latestDate As String
Dim i As Long
latestDate = myData(1, ColumnsIndex(3) - 1)
For i = 1 To UBound(myData, 1) - 1
If latestDate < myData(i, ColumnsIndex(3) - 1) Then
latestDate = myData(i, ColumnsIndex(3) - 1)
End If
Next
GetLatestDateFromData = latestDate
End Function
Private Function GetEarliestDateFromData() As String
Dim earliestDate As String
Dim i As Long
earliestDate = myData(1, ColumnsIndex(2) - 1)
For i = 1 To UBound(myData, 1) - 1
If earliestDate > myData(i, ColumnsIndex(2) - 1) Then
earliestDate = myData(i, ColumnsIndex(2) - 1)
End If
Next
GetEarliestDateFromData = earliestDate
End Function
The problem is that my results are the following ones:
startingFrom = DateValue(GetEarliestDateFromData) 'returns 01/02/2017, 1st of February
untilDate = DateValue(GetLatestDateFromData) 'returns 01/06/2017, 1st of June
Seems I have a problem with the date formatting. Somehow, days and months are mixed. How do I fix it?
Thanks
EDIT: DateSerial (as suggested in a linked thread) does not apply here because I not only care about the date but the time as well. DateSerial only takes year-month-day as arguments.
To fix your dates use the format function, e.g.
date = Format(value, "MM\/DD\/YYYY")
More easily you could just compare the actual values (e.g. 02/01/2017 06:07 equals 42737,2548611111) which are independent of the displayed format.
Furthermore I'd suggest you use the WorksheetFunction.Max function which is the vba equvalent to excel Max-function, returning the greatest vaule in your range, something like:
date = WorksheetFunction.Max(your_used_range)
I am trying to write VBA for the first time in many years and I am having trouble getting started.
I am creating a form that users will fill out. There is no data until the user fills in the two columns. They will enter information first in column A and then in column B.
Then in each cell they can enter ABC followed by a date or XYZ followed by a date
I am trying write code that will do the following:
When a cell in column B is changed, I want to check to see if it contains the string "ABC" followed by a date (i.e. "ABC7/29/14" or "ABC 7/29/14").
Where the date format is inconsistent (i.e. sometimes it would be 07/29/2014, sometimes 7/29/14).
If the cell does contain ABC followed by a date, I want to check if that date falls within a specified date range (ie. 07/29/14 to 7/30/14). This date range will be hardcoded in.
If the date does fall within that range then I want to check the cell in the same row to the left (column A) to see if it contains the same string "ABC" followed by a date range.
If the second cell does contain ABC followed by a date I want to check if that date falls within a second specified date range (i.e. "ABC10/12/14" or "ABC 10/13/14").
If all these conditions are met I want to have a message box pop up.
Thank you so much in advance. I have written a few things for this and I am just not getting good results or even things that run correctly every time.
****EDIT****
I have updated my code to what I am currently working with. I am getting a compile Error: Object Required and it is highlighting my Set FirstPmtLDate line. Also the code is running as soon as any cell is changed. I really only want it to run when cells in B column are selected.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SecondPmt As Range
Dim FirstPmt As Range
Dim FirstPmtLDate As Date
Dim FirstPmtUDate As Date
Dim SecondPmtLDate As Date
Dim SecondPmtUDate As Date
Set SecondPmt = ActiveCell
Set FirstPmtLDate = DateValue(7 / 29 / 2014)
Set FirstPmtUDate = DateValue(7 / 30 / 2014)
Set SecondPmtLDate = DateValue(10 / 12 / 2014)
Set SecondPmtUDate = DateValue(10 / 13 / 2014)
Application.EnableEvents = False
'If target cell is empty post change, nothing will happen
If IsEmpty(Target) Then
Application.EnableEvents = True
Exit Sub
End If
'Using If Not statement with the Intersect Method to determine if Target
'cell is within specified range
If Not Intersect(Target, Range("B2:B16")) Is Nothing Then
'Checks if cell contains ABC in any case
If InStr(SecondPmt.Value, "ABC", vbTextCompare) <> 0 Then
'Remove any spaces user may entered
SecondPmt = Replace(SecondPmt, " ", "")
'Finds date after ABC in any format
SecondPmt = Mid(SecondPmt, 4)
'Checks if it is 07/29/14 or 7/30/14
SecondPmtDate = DateValue(SecondPmt)
If SecondPmtDate = SecondPmtLDate Or SecondPmtDate = SecondPmtUDate Then
'Then if it does have one of those dates the cell to the left is selected
FirstPmt = SecondPmt.Offset(0, -1)
'Checks if new cell contains ABC in any case
If InStr(FirstPmt.Value, "ABC", vbTextCompare) <> 0 Then
'Remove any spaces user may entered
FirstPmt = Replace(FirstPmt, " ", "")
'Finds date after ABC in any format
FirstPmt = Mid(FirstPmt, 4)
'Checks if it is 10/12/14 or 10/13/14
FirstPmtDate = DateValue(FirstPmt)
If FirstPmtDate = FirstPmtLDate Or FirstPmtDate = FirstPmtUDate Then
'Then if it does have one of those dates Pop up message box
MsgBox "This is not a valid entry!"
End If
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
Try this:
If InStr(s, "ABC") <> 0 Then
s = Mid(s, 4)
d = DateValue(s)
....
End If
where s is the string from your cell. Don't mind the spaces and additional zeros. The DateValue function will do it. Just check if the regional settings on your computer and in Excel are appropriate for the date format you want to use. (see the documentation)
Dont worry about the presence or not of leading zeroes in your date, the Format() function will manage that for you
dim strDate as string
dim strDateStart as string
dim strDateEnd as string
dim dtDate as date
dim dtStart as date
dim dtEnd as date
strDateStart = "07/29/2014"
strDateEnd = "07/30/2014"
' assuming your in the US and the locale date format of your system is mm/dd/aaaa as this is on what Cdate will operate on
' convert stribgs to dates
dtStart = Cdate(strDateStart)
dtEnd = Cdate(strDateEnd)
'assuming that FirstPmt contains ABCdateinanyformat
' we extract the date part (remove ABC) and we format the date
strDate = (Format( left(FirstPmt.value,4),"mm/dd/yyyy")
dtDate = Cdate(strDate)
' you can check if the date is within your range of dates like:
if dtDate >= dtStart) and (dtDate <= dtEnd) then
' do your stuff
end if