my user form has three separate combo boxes for the users to select the following: Year, Month, Date (they are not dependent). For example if the user selects 2017 (the year), May(the month) and 23(the day) I want vba to enter in column two on my database sheet: "2017/05/23". I want it exactly in this format as a value.
The code below doesn't work. Any help would be appreciated.
With ws
.Cells(lRow, 2).Value = Me.cboYear / Me.cboMonth / Me.cboDay.Value
End With
You're dividing the year by the month, and then dividing that by the day. That's the value your cell is getting.
Build an actual date instead.
.Cells(lRow, 2).Value = DateSerial(cboYear, cboMonth, cboDay)
And then format that date any way you wish, using NumberFormat:
.Cells(lRow, 2).NumberFormat = "yyyy/MM/dd"
DateSerial expects integer values. If your cboMonth contains strings (month names), then you need to work a bit harder for it - the easiest is probably just to use a keyed collection - specify a string key when .Adding the integers to the collection:
Static months As Collection
If months Is Nothing Then
Set months = New Collection
With months
.Add 1, "January"
.Add 2, "February"
.Add 3, "March"
'...
.Add 12, "December"
End With
End If
And then you have an easy lookup:
Dim monthId As Integer
monthId = months(cboMonth)
So your DateSerial would be:
.Cells(lRow, 2).Value = DateSerial(cboYear, monthId, cboDay)
Related
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 😀
I've had a look around and can't find an actual answer to this.
I have a .csv to download every day. In it includes a text field 7+2 digits long. The 7 digits are in format CYYMMDD and the 2 digits are blank spaces.
This would be today's date: "1190729 " (without the quotes)
I've tried about 20 ways to convert this to a regular date, but I can't get every record to update properly
So far
The QueryTable uses type 2 (Text)
I =TRIM the text, place it back in the same location
I change the text into a recognisable date
"Paste as Text"
Then I get the same thing every time. Any date where the DAY is 13 or more, is a text field. 12 and under is a date field
The best way to fix it is to F2 but this is meant to be a totally automated report
I have tried changing dd/mm/yyyy to every other version I can think of (as for my excel m/d/yyyy is the default)
I've also tried moving .Value = .Value to the bottom, putting it in twice etc. but to no avail
Private Sub CopyDateTime(ByVal lastRowBeforeImport As Long)
Dim ws As Worksheet, ws2 As Worksheet
Dim tempsheet As String
Dim lastRowAfterImport, lastRowTemp
Set ws = Worksheets("Report")
'Bottom populated cell of Column "B"
lastRowAfterImport = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
tempsheet = "temp"
Worksheets.Add
ActiveSheet.Name = tempsheet
Set ws2 = Worksheets("temp")
With ws.Range(ws.Cells(lastRowBeforeImport, 5), ws.Cells(lastRowAfterImport, 6))
'Copy new date and time to tempsheet'
.Copy Destination:=ws2.Range("A1")
End With
lastRowTemp = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
With ws2.Range(Cells(1, 3), Cells(lastRowTemp, 3))
.FormulaR1C1 = "=TRIM(RC[-2])"
.Value = .Value
.Copy Destination:=ws2.Range("A1")
.Delete
End With
With ws2.Range(Cells(1, 3), Cells(lastRowTemp, 3))
.FormulaR1C1 = "=RIGHT(RC[-2],2)&""/""&MID(RC[-2],4,2)&""/20""&MID(RC[-2],2,2)"
.Value = .Value
.NumberFormat = "dd/mm/yyyy"
End With
With ws2.Cells(1, 4)
.FormulaR1C1 = "=MID(TEXT(RC[-2],""000000""),3,2)&"":""&LEFT(TEXT(RC[-2],""000000""),2)&"":""&RIGHT(RC[-2],2)"
End With
'Delete tempsheet'
Application.DisplayAlerts = False
'Worksheets(tempsheet).Delete
Application.DisplayAlerts = True
End Sub
If you have "1190729 " in A2 then the formula
=DATE(2000+(MID(A2,2,2)),(MID(A2,4,2)),(RIGHT(TRIM(A2),2)))
will produce the date 29th July 2019 in your current date format
From MSDN:
Date variables are stored as IEEE 64-bit (8-byte) floating-point
numbers that represent dates ranging from 1 January 100, to 31
December 9999, and times from 0:00:00 to 23:59:59.
Your VBA function may parse well string formats from CSV, but you are creating a string value which is not a proper Excel data type for dates.
Use =DATEVALUE function to convert the string representation of the DATE (ex. 29/7/2019) to the actual Excel date.
For example in your case: cell.Value = DATEVALUE(TRIM(RC[-2]))
Once in the proper data type, you can change the date format using the NumberFormat property.
More about DATEVALUE from MSDN.
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
Im currently creating a template for our report. And I would like to do some automation.
I have a source sheet which I call "KPISource" (Data source is in sharepoint, thus this is a table). And in the first column I would like to get data which has has the current Month and the previous month.
Basically, If it is current month, it will then put the data in the "August" column. And If the date is previous month, then it will also put the data in the "July".
In my source sheet, the columns are Date, Tickets Solved (productivity), YTD, Ticket Reopen Rate(quality), Aging <5 days (Quality), YTD (Aging <5 days) Aging > 5 days (Quality), YTD (Aging >5 days), Customer Satisfaction, YTD (Customer Satisfaction)
Currently here is my code, but no output is appearing. This is the code that I'm trying if the there is a previous date in column 1 (KPISource), then it will have the value in KPI.Cells(6, 4).Value (Tickets Solved "July").
Sub OperationalKPI()
Dim KPI As Worksheet
Set KPI = Sheets("OperationalKPI")
Dim KPISource As Worksheet
Set KPISource = Sheets("KPISource")
mPrevious = Format(DateAdd("m", -1, Date), "mmmm")
mCurrent = Format(Date, "mmmm")
lastrow = KPISource.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow
If mPrevious = KPISource.Cells(x, 1) Then
KPI.Cells(6, 4).Value = KPISource.Cells(x, 2).Value
End If
Next x
End Sub
The problem, based upon your feedback, is in the line
If mPrevious = KPISource.Cells(x, 1) Then
mPrevious is a string containing the name of the month, eg "July", however KPISource.Cells(x, 1) contains a date so the two are never going to be equal.
Change the line to:
If mPrevious = Format(KPISource.Cells(x, 1),"mmmm") Then
This will make both items strings with the name of the month in them and the If should find the matches.
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.,