I have a VBA script that opens up a bunch of CSV files, and compiles them into one summary report.
However, I'm having a problem where it reads in UK style dates (dd/mm/yyyy), then interprets them as US-style dates when it makes the copy, before display them as UK-style dates again!
So 4th of July in original sheet becomes 7th of April in the summary sheet - verified by changing cell format to display month name.
This is odd, as when you open up the CSV file in Excel, it correctly interprets the UK style date.
Copy is made using code like this
SummarySheet.Cells(Y,X).value = CSVSheet.Cells(W,Z).value
What is going on here?
You did not post the code as to how you are opening your CSV files -- that is the critical area. The dates need to be parsed properly BEFORE being entered on the worksheet. The following code will selects and then opens a file that has UK style dates in a single column, and properly parse them. You will need to adapt it to your particular requirements.
The FieldInfo argument is what does the work. The formatting of the Excel worksheet is "for show" so you can see an unambiguous date.
Option Explicit
Sub OpenUKcsv()
Dim sFile As String
Dim WB As Workbook
Dim WS As Worksheet
sFile = Application.GetOpenFilename()
Workbooks.OpenText Filename:=sFile, DataType:=xlDelimited, comma:=True, other:=False, _
fieldinfo:=Array(1, 4)
Set WB = ActiveWorkbook
Set WS = ActiveSheet
With WS.Columns(1)
.NumberFormat = "dd-mmm-yyyy"
.EntireColumn.AutoFit
End With
End Sub
You could use .Text (text displayed in Excel cell) or .Value2 (value without formatting) instead of .Value (value with formatting).
But I strongly suggest that you set the format of the cells that you use to what you expect to have at the end with .NumberFormat = "mm/dd/yyyy"
Or you could use CDate function :
SummarySheet.Cells(Y,X).value = CDate(CSVSheet.Cells(W,Z).value)
Or use an UDF with DateSerial :
Sub test_CMaster()
MsgBox ParseDate("4/7/15") & vbCrLf & CDate("4/7/15")
End Sub
Function ParseDate(ByVal DateInCell As String, Optional Separator As String = "/") As Date
Dim D() As String
D = Split(DateInCell, Separator)
ParseDate = DateSerial(D(UBound(D)), D(1), D(0))
End Function
Try using the Workbooks.OpenText() method instead and set the Local flag to True
Set csvWB = Workbooks.OpenText(Filename:=myCSVfile, Local:=True)
Here is the MSDN article on this method which says for the Local setting:
Specify True if regional settings of the machine should be used for separators, numbers and data formatting.
Maybe you can convert the CSV files to show dates as numbers, ie. 10th Nov 15 will show as 42318. Or add a separate column where B1 is =DATEVALUE(A1) and work with that.
When you create the summary report, import the numbers and convert them to date using CDate and Format. Something like this:
Sub test()
Range("A2:A4").NumberFormat = "m/d/yyyy"
Range("A2").Value = Format(CDate(Range("A1").Value), "dd.mm.yyyy")
Range("A3").Value = Format(CDate(Range("A1").Value), "mm.dd.yyyy")
Range("A4").Value = Format(CDate(Range("A1").Value), "Long Date")
End Sub
EDIT:
For better formatting (no need for NumberFormat, I think it will use your regional settings right away) and auto-setting the cell format to date-type, use this:
Sub test()
Dim sDate As Date
sDate = CDate(Range("A1").Value)
Range("A2").Value = DateSerial(Year(sDate), Month(sDate), Day(sDate))
End Sub
Result:
References:
http://www.techonthenet.com/excel/formulas/format_date.php
http://www.techonthenet.com/excel/formulas/cdate.php
Related
I've got a URL like this:
http://www.xyz342.net/abc/date_from=24.05.2018 00:00:00&date_to=24.05.2018 00:00:00&abc=2
I've used the following vba code to extract the table into excel:
Sub GetWebTable()
With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.xyz342.net/abc/date_from=24.05.2018 00:00:00&date_to=24.05.2018 00:00:00&abc=2", Destination:=Range("a1"))
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End Sub
Task: I want to extract the table for each day of 2018 automatically until today. Therefore the date in that above given URL has to be changed every time (e.g. http://www.xyz342.net/abc/date_from=20.09.2018 00:00:00&date_to=20.09.2018 00:00:00&abc=2 gives the table for 20.09.2018). How can I do that?
Perfect would be a new worksheet for each day. Every future day should be automatically added.
This should give you some ideas in terms of generating the dates in a loop and concatenating into the URL the current date. It also demonstrates how to add new sheets.
I think there are likely better scraping methods than generating queryTables like this. If you can share HTML for one link (And the lay out is the same for each day) it may be possible to devise a much better approach.
Following on from #Marcucciby2's comment you might also get startdate with something like: startDate = DateSerial(YEAR(Date), 1, 1)
Unless the historic tables are refreshed then you probably only want to run the below once. Then remove the loop and simply have the date generated from dateString = Format$(Date, "dd.mm.yyyy"), or Date-1 to get the prior day. You mention wanting it to be added automatically; You could tie to a change event that is linked to a cell where you select a date from a drop down.
Option Explicit
Public Sub test()
Dim url As String, startDate As Long, endDate As Long, i As Long, dateString As String
startDate = DateValue("2018-01-01")
endDate = CLng(Date)
For i = startDate To endDate
DoEvents
dateString = Format$(i, "dd.mm.yyyy")
url = "http://www.xyz342.net/abc/date_from=" & dateString & " 00:00:00&date_to=" & dateString & " 00:00:00&abc=2"
AddQueryTable url, dateString
Next
End Sub
Public Sub AddQueryTable(ByVal url As String, ByVal dateString As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.Add
ws.NAME = dateString
On Error Resume Next
With ws.QueryTables.Add(Connection:="URL;" & url, Destination:=ws.Range("a1"))
.Refresh BackgroundQuery:=False
.SaveData = True
End With
On Error GoTo 0
End Sub
In Excel's VBA I want to create a formula which both takes the value from the source cell and the format.
Currently I have:
Function formEq(cellRefd As Range) As Variant
'thisBackCol = cellRefd.Interior.Color
'With Application.Caller
' .Interior.Color = thisBackCol
'End With
formEq = cellRefd.Value
End Function`
This returns the current value of the cell. The parts that I have commented out return a #VALUE error in the cell. When uncommented it seems the colour of the reference is saved however the Application.Caller returns a 2023 Error. Does this mean that this is not returning the required Range object?
If so how do I get the range object that refers to the cell that the function is used? [obviously in order to set the colour to the source value].
Here's one approach showing how you can still use ThisCell:
Function CopyFormat(rngFrom, rngTo)
rngTo.Interior.Color = rngFrom.Interior.Color
rngTo.Font.Color = rngFrom.Font.Color
End Function
Function formEq(cellRefd As Range) As Variant
cellRefd.Parent.Evaluate "CopyFormat(" & cellRefd.Address() & "," & _
Application.ThisCell.Address() & ")"
formEq = cellRefd.Value
End Function
This is the solution I found to the above question using Tim William's magic:
Function cq(thisCel As Range, srcCel As Range) As Variant
thisCel.Parent.Evaluate "colorEq(" & srcCel.Address(False, False) _
& "," & thisCel.Address(False, False) & ")"
cq = srcCel.Value
End Function
Sub colorEq(srcCell, destCell)
destCell.Interior.Color = srcCell.Interior.Color
End Sub
The destCell is just a cell reference to the cell in which the function is called.
The interior.color can be exchanged or added to with other formatting rules. Three extra points to note in this solution:
By keeping the value calculation in the formula this stops the possibility for circular referencing when it destCell refers to itself. If placed in the sub then it continually recalculates; and
If the format is only changed when the source value is changed, not the format as this is the only trigger for a UDF to run and thus change the format;
Application.Caller or Application.ThisCell cannot be integrated as when it refers to itself and returns a value for itself it triggers an infinite loop or "circular reference" error. If incorporated with an Address to create a string then this works though as per Tim William's answer.
Want to check if the cell is a date time value using the ISO format i.e.
2012-04-12T00:00:00
Current try:
If mainsht.Cells(r, 6).Value = "" Or mainsht.Cells(r, 6).Value = "####-##-##T##:##:## Then
GoTo next6
Still it does not seem to match the format in vba and cell value, as I have many cells with this correct format and still activating the else statement i.e. not recognized by the "####-##-##T##:##:##".
Maybe yyyy-mm-ddThh-MM-ss?
ISO date come in several formats, adding an asterisk "####-##-##T##:##:##*" would be more versatile.
2011-01-01T12:00:00Z
2011-01-01T12:00:00+05:00
2011-01-01T12:00:00-05:00
2011-01-01T12:00:00.05381+05:00
Example:
If mainsht.Cells(r, 6).Value = "" Or mainsht.Cells(r, 6).Value Like "####-##-##T##:##:##*" Then
You might want to look at this post: Parsing an ISO8601 date/time (including TimeZone) in Excel
The following UDF¹ can be used as a worksheet function or a helper function in a VBA project.
Option Explicit
Function IsISODateTime(str As String)
Dim n As Long, nums() As Variant
Static rgx As Object, cmat As Object
'with rgx as static, it only has to be created once; beneficial with repeated calls to the UDF
If rgx Is Nothing Then
Set rgx = CreateObject("VBScript.RegExp")
End If
IsISODateTime = vbNullString
With rgx
.Global = False
.MultiLine = False
.Pattern = "[0-9]{4}\-[0-9]{2}\-[0-9]{2}[A-Z]{1}[0-9]{2}\:[0-9]{2}\:[0-9]{2}"
IsISODateTime = .Test(str)
End With
End Function
The UDF returns a true boolean True/False.
The pattern I've provided is very brick-by-brick literal; it could be shortened using the methods detailed in How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops.
¹ A User Defined Function (aka UDF) is placed into a standard module code sheet. Tap Alt+F11 and when the VBE opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste the function code into the new module code sheet titled something like Book1 - Module1 (Code). Tap Alt+Q to return to your worksheet(s).
As already pointed out by Tim Williams do it like so
If mainsht.Cells(r, 6).Value = "" Or mainsht.Cells(r, 6).Value Like "####-##-##T##:##:##" ...
To test the cell for an ISO formatted date you should check the cells NumberFormat property, so your If statement should be:
If mainsht.Cells(r, 6).Value = "" Or mainsht.Cells(r, 6).NumberFormat Like "yyyy-mm-ddThh:mm:ss*" Then
Note: If the currently accepted solution is working, your cell only contains a string value (which looks like an ISO formatted date) rather than an actual date displayed using an ISO date format.
I want to display an input message response to a cell which is date formatted using CDate (dd/mm/yyyy). Why is it the code is not showing the error message if input was done as dd/mm/yy? The program accepts it but output shows as yy/mm/dd.
below is the code I created:
Sub inputSettlementDate()
Dim varInputDate As Variant
Dim lngERow As Long
varInputDate = InputBox("Please enter the Settlement Date using this format dd/mm/yyyy.", "Settlement Date")
If IsDate(varInputDate) Then
varInputDate = Format(CDate(varInputDate), "dd/mm/yyyy")
Else
MsgBox "Please enter a valid date format dd/mm/yyyy"
End If
If IsDate(varInputDate) Then
lngERow = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("B" & lngERow).Value = varInputDate
End If
End Sub
You may want to make sure Column B has a format as General, or that it doesn't have a yy/mm/dd format. I tested your code in a blank workbook without changing anything and it worked flawlessly.
I've tried almost everything in most of the other similar type questions but I can't seem to solve the runtime error. Help please!
What I want to achieve:
1) My macro is supposed to get date from report summary files that are created every day hence, it requires the user to input which date of report he wants the data from
2) I use the vlookup method to get the data from the relevant row and input it into the central workbook with the macro
3) Every part of the code works except using the date to Vlookup and it will give me this error message
4) I have tested the code using other text based lookup values and the whole macro works (i.e. i looked up the row which has the "Total" value so it looks up "Total" but i require the macro to look up the rows with the date as the look up value)
Addtional Info:
1) In the lookup file, the dates are in the format of "m/d/yyyy" but presented in the format of "dd-mmm-yy" (but i've tried both and they dont work)
Sub GetData()
Dim strDate As Date
strDate = InputBox("Input date of report to retrieve (Format: DD-MM-YYYY)", "Input Date", Format(Now(), "DD-MM-YYYY"))
If IsDate(strDate) Then
'there is some code here not relevant but basically i need to keep manipulating the date throughout the code
With ActiveSheet
Dim XstrDate
Dim Xfile As String
XstrDate = Format(strDate, "mmm DD, YYYY")
Xfile = "C:\...\...\...\Report " & XstrDate & ".xls"
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim returnValue as Variant
Set wb = Application.Workbooks.Open(Xfile)
Set ws = wb.Worksheets("Summary")
Set rng = ws.Range("A:K")
Dim Xdate As String
Xdate = Format(XstrDate, "m/d/yyyy")
returnValue = Application.WorksheetFunction.VLookup(Xdate, rng, 2, 0)
'... more code
remember, i've tried looking up using the text in the same column and it returned me a value. So i suspect the problem lies with the date format or something
Any smart and kind soul want to offer some suggestions here:)
Excel internally stores dates as a Serial Number (e.g. 1/1/2014 = 41640), which you can observe yourself if you enter a date into a cell and then change the format to Number.
With this in mind it's unlikely that a VBA date and an Excel date can be matched using the VLookup function so in my experience the best solution is to convert your date into its serial number and then perform the VLookup on that value instead.
Dim Ndate As Long
Dim returnValue As Date
Ndate = DateSerial(<Year>, <Month>, <Day>)
returnValue = Application.WorksheetFunction.VLookup(Ndate, <rng>, <col>, False)
If you need to construct your DateSerial(...) function from a Date variable in VBA you can use the Year(<date>), Month(<date>), and Day(<date>) functions to break it down into the required components.
Note: I've tried this example in the format .VLookup(DateSerial(2014,1,1),...) and it still causes the same error, hence storing the return value of DateSerial in a numeric variable first.
Happy Coding!
I've taken a different approach and found another solution to this problem.
Rather than use Vlookup, this is the other method that bypass the problem of VLookup date format problem, (having defined vdate in previous statements)
Dim rnge As Range, i As Long
Sheets("Summary").Select
Columns("A:A").Select
Set rnge = Intersect(Selection, ActiveSheet.UsedRange)
If rnge Is Nothing Then
MsgBox "Date Not Found"
GoTo done
End If
For i = rnge.Count To 1 Step -1
If rnge.Cells(i).Value = vdate Then rnge.Cells(i).EntireRow.Copy _
Destination:=ThisWorkbook.Sheets("AnotherSheet").Range("A1")
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True