I am trying to compare Dates in a vba script. I believe the main issue is my formatting however I am not sure how to solve it.
Sub Rem9()
Dim i As Long
Dim lr As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
wsName = ws.Name
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
FirstDateRead = CDate("1, 1,2018") 'Initialize the first Day of the year as the last day
For i = 1 To lr
Debug.Print FirstDateRead
Debug.Print ws.Cells(i, 1).Value
If FirstDateRead > ws.Cells(i, 1).Value Then
ws.Cells(i, 3).Value = 121325
End If
Next i
End Sub
According to my output the First Date Read is never greater than the values I am pulling, Which it is for all cases. I have included here an example of the debug.print from the script I am running to show the date formats. Additionally I want to confirm the values I am drawing from are indeed datevaluse as when I run them through the IsDate() Function it returns True.
One other issue if that my date format for the value I call is swapping the year and day. Does anyone know how to solve that. When I use the format function it returns the date as.
Assuming the cells containing the dates are in text format, try wrapping the comparison value in a cDate:
If FirstDateRead > Cdate(ws.Cells(i, 1).Value) Then
ws.Cells(i, 3).Value = 121325
End If
Try using the DateDiff function instead:
Sub dateDifference()
Dim d1 As Date, d2 As Date
d1 = CDate("1, 2,2018")
d2 = Range("A1").Value ' insert a date in A1 to test
Debug.Print DateDiff("d", d1, d2) ' first parameter set to days
End Sub
Edit #1
Use Format to compare apples with apples, so to speak:
d2 = Format(Range("A1").Value, "dd/mm/yyyy")
Related
I am new to VBA and have a pretty simple question. I built a macro that updates a data set periodically and one of the functions of the macro is that it checks to make sure that if there is data for a previous date that it replaces it.
It uses a cell reference to cross check the data set, however I found that if the date is nor formatted the same then it will not replace it. Ex. if 03/07/18 then it will not replace 03/07/2018.
Any ideas on what I could possibly do to circumvent this issue? Thank you in advance!
Here is the code I have for this part of the macro
Dim i As Integer, ValueToFind As Integer, LRow As Integer
intValueToFind = Sheet8.Range("L6")
Sheet3.Activate
LRow = Range("J" & Rows.Count).End(xlUp).Row
For i = 1 To LRow
If Cells(i, 10).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
I might do something like this:
Dim i As Long, dateToFind As Date, LRow As Long, checkValue As Variant
dateToFind = CDate(Sheet8.Range("L6").Value)
Sheet3.Activate
LRow = Range("J" & Rows.Count).End(xlUp).Row
For i = 1 To LRow
checkValue = Cells(i, 10).Value
If IsDate(checkValue) Then
If dateToFind = CDate(checkValue) Then
MsgBox ("Found value on row " & i)
End If
End If
Next
It seems like you were declaring everything to be an integer, when it's not really. Also, I use Long data types out of habit, which is why I changed your two Integers (that ARE integers) to Longs.
VBA has a built in "Date" data type, which you can read more about here. Basically, we're assigning the date to dateToFind (a Date data type), and we're using the function CDate to force the value of cell L6 to be a Date data type.
Then, we're looping through your cells, and assigning the value to a variant. We're then checking that value to see if it's "like" a date, as determined by VBA's IsDate function. If it is, we'll force it into a Date data type with CDate, and check it against dateToFind.
Note, we had to check if the value was a date with IsDate before using CDate because if the cell value is NOT in a date format, forcing it to be a Date type will throw an error. We didn't check the first time because we can be reasonably confident that the specific date cell you're using (L6) is, in fact, a Date.
Hopefully that works for you.
Did you try to clear and reapply date format ?
Something like this :
Dim i As Integer, ValueToFind As Integer, LRow As Integer
'Clear and apply a date format
Sheet8.Range("L6").ClearFormats
Sheet8.Range("L6").NumberFormat = "yyyy/mm/dd"
Columns(10).Select
Columns(10).ClearFormats
Columns(10).NumberFormat = "yyyy/mm/dd"
intValueToFind = Sheet8.Range("L6")
Sheet3.Activate
LRow = Range("J" & Rows.Count).End(xlUp).Row
For i = 1 To LRow
If Cells(i, 10).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
I have the following problem: I try to filter a date column (A) in a worksheet (HISTORICALS) to return the highest and second highest date value. Currently, there is dates ranging from the 25th to the 31st of December in this column. Unfortunately, below formula (using the Large function) returns the 31st two times (and not the 30th and 31st as intended).
Sub Select_Last_Two_Days()
With Worksheets("HISTORICALS")
Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 1), "Short Date")
Second_Highest_Max = Format(WorksheetFunction.Large(Worksheets("HISTORICALS").Range("A:A"), 2), "Short Date")
Debug.Print Highest_Max, Second_Highest_Max
End With
End Sub
The column has approx. 2000 rows, with dates occuring multiple times. So ideally I would want to filter for distinct values and then return the two highest dates. Any idea how I can do that?
Simply translate Barry Houdinis answer from How to find the first and second maximum number? to VBA:
Sub Select_Last_Two_Days()
With Worksheets("HISTORICALS")
Highest_Max = Format(WorksheetFunction.Max(.Range("A:A")), "Short Date")
Second_Highest_Max = Format(WorksheetFunction.Large(.Range("A:A"), WorksheetFunction.CountIf(.Range("A:A"), WorksheetFunction.Max(.Range("A:A"))) + 1), "Short Date")
Debug.Print Highest_Max, Second_Highest_Max
End With
End Sub
The recommendations given in the comments are probably the simplest and least amount of code way to do things but here is another sugggestion:
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("HISTORICALS")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim loopArr()
loopArr = ws.Range("A1:A" & lastRow).Value
Dim maxVal As Date
maxVal = Application.WorksheetFunction.Large(ws.Range("A1:A" & lastRow), 1)
Dim i As Long
Dim secondVal As Date
For i = UBound(loopArr, 1) To LBound(loopArr, 1) Step -1
If loopArr(i, 1) < maxVal Then
secondVal = loopArr(i, 1)
Exit For
End If
Next i
End Sub
I am trying to set up a function which will be able to check dates from one sheet (sheet1) through 2 columns: startDate and endDate in Sheet2. And if there are matching then I want to copy values from one cell which is located on sheet2 into specific cell (the same row where is the cheking date) into sheet1.
I wrote some code, but later on I've realized that my logic is not good.
I also found this link on stackoverflow website...
my xls file - function is in the module 3 "checkDate"
and here is the code..I need find function somehow..maybe I need to insert two iterators (2 for loops?)
Sub CheckDate()
Dim d1 As Date
Dim d2 As Date
Dim datumPok As Date
Dim s As String
Dim i As Long
Dim LR As Long
LR = Range("K" & Rows.Count).End(xlUp).Row
For i = 2 To LR
d1 = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 2).Value
d2 = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 3).Value
With .Range("K" & i)
datumPok = ActiveWorkbook.Worksheets("Spisak").Cells(i, 11)
If d1 < datumPok < d2 Then
MsgBox "opaaa"
s = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 4).Value
ActiveWorkbook.Worksheets("Spisak").Cells(i, 6).Value = s
Else
MsgBox "test"
End If
End With
Next i
End Sub
I am really into this..thanks guys!
I found the solution!
Ordinary lookup with some mathematic formula was enough.
=LOOKUP(2,1/((G1>=$A$1:$A$24)*(G1<=$B$1:$B$24)),$C$1:$C$24)
assuming that date is in the column G1..
Thanks to all! :)
I have a column of dates in Column D in the mm-dd-yyyy format. Below is the code that I am trying to use to delete the entire row of data if the Active Cell in Column D is either Blank, Today's Date, or older than 8 days (i.e. today is 3/13/14, so it would erase blank entries, today's date, and anything older than 3/5/14).
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Range("D" & lastrow).Select
Do
If (ActiveCell = "" Or ActiveCell = Format(Now, "mm/dd/yyyy") Or ActiveCell < Format(Now -8, "mm/dd/yyyy")) _
Then ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell = "Completed Date)"
If I use the "<" symbol, it erases everything basically, and if I use the ">" symbol, then it doesn't erase the rows with dates in February, etc. Can anyone suggest a method that will work, or why mine isn't?
I'm just thinking off the top of my head, but the moment you use the Format keyword in Excel, it probably converts the date to a text value, so you can't perform comparison operations on it...
Try this instead:
If (ActiveCell = "" Or (ActiveCell = Format(Now, "mm/dd/yyyy")) Or (Cdate(ActiveCell) < (Now -8))) _
In effect, rather than changing NOW()-8 to text, converting Activecell to a date you can use for comparison's sake.
Again, I didn't do this with VBA, but I'm guessing it should do the trick.
Good luck!!
Try use DateDiff:
If not isempty(activecell)
If DateDiff("d", Now(), ActiveCell.Value) < -8 then
'do your stuff
endif
endif
Paste the following code into a module:
Sub ScrubData()
Dim i As Long
Dim numRowsWithVal As Long
Dim myActiveCell As Range
Dim todaysDate As Date
Dim cutoffDate As Date
'Use a custom function to delete all blank rows in column specified
Call DeleteAllBlankRowsInColumn("D")
'Use VBA's Date() function to get current date (i.e. 3/13/14)
todaysDate = Date
'Set the cutoff date to anything older than 8 days
cutoffDate = todaysDate - 8
'***** Loop through all rows and clear values if rows are equal to today's date or older than 8 days ******
'Count the number of rows with values (subtract one because sheet has headers)
numRowsWithVal = (Range("D" & Rows.Count).End(xlUp).Row) - 1
'Start at Range("D2")
Set myActiveCell = ActiveSheet.Range("D2")
For i = 0 To numRowsWithVal - 1
Select Case True
'If value of cell is today's date OR older than 8 days clear the values
Case myActiveCell.Offset(i, 0).Value = todaysDate, myActiveCell.Offset(i, 0).Value <= cutoffDate
myActiveCell.Offset(i, 0).ClearContents
'Value is valid, do nothing
Case Else
End Select
Next
'***********************************************************************************************************
'Now that values are cleared, delete all blank rows again
Call DeleteAllBlankRowsInColumn("D")
End Sub
Public Function DeleteAllBlankRowsInColumn(ByVal columnLetter As String)
'Delete all blank rows in column specified (suppress errors just in case there aren't any blank cells)
On Error Resume Next
Columns(columnLetter).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Set error handling back to normal
On Error GoTo 0
End Function
Before:
After:
I have a vba code that determines the date based on 3 cells in excel, it then reformats the date.
Sub Test()
Dim i As Long
i = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
Range("K3").Formula = "=DATE(A3,G3,H3)"
Range("K3").AutoFill Destination:=Range("K3:K28")
Set fmt = Range("K3:K28")
fmt.NumberFormat = "ddmmmyyyy"
End Sub
The line that gives a value to "i" (which is 28) determines the last populated cell in that column.
I would like to use the value of "i" as K28 in the range.
I am fairly new to VBA and have not been able to figure out how to accomplish this task.
You can slightly simplify your code. There is no need to use AutoFill:
Sub Test()
Dim i As Long
With Sheet1
i = .Cells(.Rows.Count, 2).End(xlUp).Row
With .Range("K3:K" & i)
.Formula = "=DATE(A3,G3,H3)"
.NumberFormat = "ddmmmyyyy"
End With
End With
End Sub