I am attempting to remove all dates before a certain time period, as well as anything that is not a date from my data set. I have roughly 4000 entries in column A dating back the last 10 years, with some typo's mixed in. There are no blanks spots between the data.
I have cobbled together the below code, which almost works. However there is one entry 31/12/1019 which is not being picked up as an old date, or a typo.
Sub deleterows()
lastRow = Sheets("ConData").Cells(Rows.Count, 1).End(xlUp).Row
bankingDate = DateSerial(Year(Date), Month(Date), 0)
For i = lastRow To 1 Step -1
If IsDate(Cells(i, 1)) = False Or _
Cells(i, 1).Value <= bankingDate Then Rows(i).EntireRow.Delete
Next
End Sub
Any help would be appreciated.
Let's break it down, this is a wonderful inconsistency between Excel and VBA:
According to THIS article:
In Windows, the range of valid dates is January 1, 100 A.D., through December 31, 9999 A.D.; the ranges vary among operating systems.
so IsDate will return TRUE for 31/12/1019
But
Since Excel actually stores "dates" as a double with 1900-01-01 being 1.00 the date would be stored as a string in the worksheet and the Cells(i, 1).Value <= bankingDate would return False because a string is larger than a number.
But as #BigBen stated:
Cast to a date first before comparing to bankingDate.
If Not IsDate(Cells(i, 1).Value) Then
Rows(i).EntireRow.Delete
ElseIf CDate(Cells(i, 1).Value) <= bankingDate
Rows(i).EntireRow.Delete
End If
IsDate will give true but you can check then for
isNumeric(Cells(i, 1).value2
If not IsDate(Cells(i, 1)) or not isNumeric(Cells(i, 1).value2) or ...
Value2 gives a double for Date Cells which are later then 0.1.1900
And I believe your banking date will always be later 😀
Related
I want to copy/paste formulas in columns where the date is less than today's date.
This goes beyond the criteria and replaces non matching criteria to fit the criteria.
I have a spreadsheet with data from A1:I3. Row 1 contains dates, Rows 2 & 3 contain formulas. The dates in row 1 run from 03/01/22 - 03/09/22.
My macro looks for any dates less than today's date & copies & pastes the formulas as values. This works but the dates in H & I, 03/08/22 and 03/09/22 respectively, are replaced with 03/07/22.
Dim K As String
K = Date
MsgBox K
Dim i As Integer
For i = 1 To 9
If (Cells(1, i).Value < K) Then Cells(1, i).EntireColumn.Copy
Cells(1, i).PasteSpecial xlPasteValues
Next i
End Sub
Your logic only checks when copying, but not when pasting.
Cells(1, i).PasteSpecial xlPasteValues
This is executed for every single i, regardless of whether (Cells(1, i).Value < K) is True or False. You need to use the multi-line If...End If syntax.
If Cells(1, i).Value < K Then
Cells(1, i).EntireColumn.Copy
Cells(1, i).PasteSpecial xlPasteValues
End If
To make this better though, avoid working with a String representation of a date, and bypass the clipboard:
If Cells(1, i).Value < Date Then
Columns(i).Value = Columns(i).Value
End If
I have two columns of 15 minute date/time interval data. One is formatted in 24-hour time and the other 12-hour. These come from two different sources, and reformatting the source data is not an option. All of these intervals are showing as exact matches (even as values), but when I use a lookup formula (INDEX/MATCH & VLOOKUP) or even VBA, a match for every third interval is not being identified. I have attached sample pictures with formulas as well as my code below. Thanks in advance!
Sub MatchTest()
Dim i As Integer
For i = 2 To 22
If CDate(Cells(i, 1).Value) = CDate(Cells(i, 3).Value) Then
Cells(i, 8) = Cells(i, 2)
ActiveCell.Offset(1, 0).Select
Else:
Cells(i, 8) = "NA"
ActiveCell.Offset(1, 0).Select
End If
Next i
End Sub
Instead of Cdate, Timevalue and Datevalue can be used can be used. The TIMEVALUE function returns a serial number of a time. The DATEVALUE function converts a date that is stored as text to a serial number that Excel recognizes as a date.
For instance, Timevalue of 08/12/2008 20:00:00 and 08/12/2008 08:00PM yields the same result 0.833333333335759
Datevalue of same date in different format will also yield same result
TIMEVALUE(TEXT(yourdate, "DD/MM/YYYY HH:MM:SS"))
TIMEVALUE(TEXT(yourdate, "DD/MM/YYYY HH:MM AM/PM"))
DATEVALUE(TEXT(yourdate, "DD MMMM YYYY"))
Hey all thanks for your answers. All three of these methods worked.
If TimeValue(Cells(i, 1).Value) = TimeValue(Cells(i, 3).Value) Then
If DateValue(Cells(i, 1).Value) = DateValue(Cells(i, 3).Value) Then
If Abs(CDate(Cells(i, 1).Value) - CDate(Cells(i, 3).Value)) < 0.000001 Then
I'm trying to find a way to automatically insert a column based on a date. Here's some context:
The top row of my spreadsheet (Row 1) contains dates in the format yyyy/mm/dd
The dates aren't day-by-day; they are weekly (i.e. one cell may say 2015/09/21 the next will say 2015/09/28 and the next will say 2015/10/05) so this can change from year to year
I need to find a way to automatically insert ONE column at the end of each quarter and TWO columns at the end of each half (i.e. ONE column between March and April, TWO between June and July, ONE between September and October, and TWO between December and January)
So far, this is what I am using to traverse the top row and see if the date is before October but after September. The dates start from cell I1. Although the code executes without any error, it does not actually do anything. Any help you all can offer will be appreciated.
With Sheets("Sheet1")
Range("I1").Select
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value < DateValue("2015/10/1") And ActiveCell.Offset(0, 1).Value > DateValue("2015/9/28") Then
Range(ActiveCell).EntireColumn.Insert
End If
ActiveCell.Offset(0, 1).Select
Loop
End With
I think you're off to a good start with your method. You should be able to just check if the day of the month is less than or equal to 7. That should indicate the first week in a month. If that month is 4 or 10, insert a column. If it's 1 or 7, insert two.
Dim r As Range
Set r = Range("I1")
Do Until IsEmpty(r)
If Day(r) <= 7 Then
Select Case Month(r)
Case 4, 10
r.EntireColumn.Insert
Case 1, 7
r.Resize(1, 2).EntireColumn.Insert
End Select
End If
Set r = r.Offset(0, 1)
Loop
Going strictly on a change in months bewteen two cell in the header row may be the easiest logic.
Sub insert_quarter_halves()
Dim c As Long
With Worksheets("Sheet8") 'set this worksheet reference properly!
For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
If (Month(.Cells(1, c - 1).Value2) = 3 And Month(.Cells(1, c).Value2) = 4) Or _
(Month(.Cells(1, c - 1).Value2) = 9 And Month(.Cells(1, c).Value2) = 10) Then
.Cells(1, c).EntireColumn.Insert
ElseIf (Month(.Cells(1, c - 1).Value2) = 6 And Month(.Cells(1, c).Value2) = 7) Or _
(Month(.Cells(1, c - 1).Value2) = 12 And Month(.Cells(1, c).Value2) = 1) Then
.Cells(1, c).Resize(1, 2).EntireColumn.Insert
End If
Next c
End With
End Sub
When inserting columns, always travel from right to left or you risk skipping an entry that was pushed forward.,
I need some help with some VBA Excel code to format a spreadsheet please.
I have to run a report that give me an excel spreadsheet which has an invoice date in column P. I need to delete the entire row if the invoice date in the cell in column P is less than or equal to 60 days from todays date, and also delete any row that has an invoice date in column P of 4 years or more from todays date.
I normally have to do this manually each time I run the report so I would like to automate the process with some VBA code. Can anyone help me with this please.
Dim x As Long
For x = [a1].SpecialCells(xlCellTypeLastCell).row To 1 Step -1
Debug.Print Cells(x, "P").Value
If CDate(Cells(x, "P")) > Date - 60 Then
Cells(x, "P").EntireRow.Delete
Else
Exit Sub
End If
Next x
I got the above code to work
Dim LastRow as Integer
Dim row as Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
For row = 2 To LastRow
If Cells(row, 16).Value < Date - 59 OR Cells(row, 16).Value > Year(Cells(row, 16)) + 4 Then
Rows(row).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
Next row
I had this more or less lying around, and tweaked it a bit. Let me know if this works for you.
In the following picture of an Excel sheet, the heading of the first column, and then of every 7th column after that, contains a month and a year.
I am trying to think of some code which would make entering complete dates under these headings faster. Since the month and the year are already present, I'm thinking there must be a way to enter just the day, and get the whole thing. For example, if "21" were entered in cell A26, "2/21/2015" would result.
Anyone have an idea for how I might get this output?
Edit: Thanks to the helpful replies on this forum, I figured out exactly how to do this. Here is the code for my finished product, in case anyone wants to do something similar:
Private Sub Worksheet_change(ByVal Selection As Range)
Set Sel = Selection
If Sel.Count > 1 Then
Exit Sub
End If
If (Sel.Column - 1) Mod 7 = 0 Or Sel.Column = 1 Then
'In my case, date columns always follow the pattern of 1, 8, 15...
If Sel.Value > 31 Or Sel.Value = "" Then
Exit Sub
Else
Sel.NumberFormat = "General"
Sel.Value = Left(Cells(1, Sel.Column), InStr(Cells(1, Sel.Column), ",") - 1) & " " & _
Sel.Value & Right(Cells(1, Sel.Column), 6)
Selection.NumberFormat = "m/d/yyyy"
End If
End If
End Sub
How about entering the day numbers, selecting the range where these day numbers are entered, and running the below:
Sub Add_month_year()
Dim c As Range
For Each c In Selection
c = Left(Cells(1, c.Column), InStr(Cells(1, c.Column), ",") - 1) & " " & _
c.Value & Right(Cells(1, c.Column), 6)
Next
End Sub
This should return the full dates in date code, which you can then format as you see fit.