Convert Dates to Text Format Using a Macro

In VBA, the FORMAT function works almost exactly the same as the Excel TEXT function does, i.e.

Range("A2")=Format(Range("A2"),"MMM-YYYY")

So you could write a loop using this functionality to change a range of cells via VBA.

Hi

Thanks for the suggestion. I tried this out as a test but it does not do what I need.

In cell A2 of an excel sheet I put in "30/04/2007" as a date, run the macro below and it changed it to "01/04/2007". But I need it to change to "Apr-2007". When I use the text function it does exactly this.

Sub test()
Range("A2") = Format(Range("A2"), "MMM-YYYY")
End Sub

Elvis

It looks like we also need to change the format of the cell from Date to Text in the process to get it to display properly, i.e.

Alternatively, the following code would change keep it is a date but simply change the format, but I am unsure if that will give you what you need for your purposes:

Elvis

Do you really need to get the date as text on the worksheet?

How is the date bsing used in the code?

Norrie

I need the data to read as a month instead of a underlying date because I'm basically consolidating data from the individual csv sheets in a summary workbook to create a monthly timseries.

Although the raw sheets contain monthly data, the exact dates within the month vary. So in one sheet all dates may be at the end of the month (31/12/06), in another sheet the start of the month (01/12/06) and in another mid month (15/12/06). That's why I need to have all these dates read to read as dec -2006, otherwise they will not consolidate in my summary sheet cause excel reads the underlying format even though the date is formatted as mmm-yyyy. Hope this makes sense.

Anyway, the code provided by jim works for a given cell. I've tried to adopt it to work on a range of cells using the macro below but there is an error in the syntax. Does anybody know what's wrong? (Also on a side note, ideally I need the range to select itself based on all cells containing data in col A, a continous range)

Thanks

Elvis

Sub test2()

Dim c As Date
Dim rng As range
Set rng = range("A1:A20")
For Each c In rng.Cells
c.NumberFormat = "@"
c = Format(c, "MMM-YYYY")
Next c
End Sub

Elvis

I still don't see the need to actual change the dates, but then again I've not seen your code.

Hi,

Ok, in my summary sheet, the dates are set up as dd/mm/yyyy. e.g 30/04/2007. Now lets say in three of the raw data files the dates are as follows:

File1: 30/04/2007
File2: 01/04/2007
File3: 25/04/2007

When I run my macro, it will attempt to match dates between the summary sheet and the raw data files. In the above case only the values associated with the date 30/04/2007 in file1 will be updated because the underlying dates of the other files are different. As a result the other coloumns in my summary sheet will not be updated because the match function will fail.

So what I've done in my summary sheet is changed the dates to text (using the text function) to this format: MMM-YYYY). I need to do the same with the raw data files otherwise the match will not work.

I guess another way around this would be to use some kind of function (right function maybe) that only attempts a match based on the year and month part of the date between the summary sheet and the source data files. But I don't know how easy that would be to do.

Elvis

Elvis

Any chance of seeing some code?

Like I said I don't really see why you need to change the data, but like I say I've not seen the code.

It should be easy enough to do a comparison in the code, perhaps using the Format function that jm14 has already posted.

Noorie,

Sure here is the code. It's quite complicated so unless you know the structure of the set up might not be easy to follow. But I've tried to breakout the relevant section for you under the heading RELEVANT CODE.

Elvis


Private Sub dataupdate()
Dim Lastrow As Long, Nextrow As Long
Dim File_name As String, Directory As String, Searchname As String, stpt As String
Dim lastquotedate As String, Lastdate As String, Source_Data_File As String, Col_Name As String
Dim c As Integer, lcol As Integer, vcol As Integer
Dim csv_file As Workbook, wb As Workbook
Dim rng1 As Range, rng2 As Range, rngstart As Range

Application.ScreenUpdating = False

'//Determine path name for finding & opening downloaded csv data files
'//which will have been automatically saved to the same file folder as the historical data workbook
File_name = ActiveWorkbook.FullName 'full name of current workbook
Searchname = ActiveWorkbook.Name
endpos = InStr(1, File_name, Searchname, 1)
endpos = endpos - 1
Directory = Left(File_name, endpos) 'drive and folders etc where the downloaded files are stored

'// find last column of data
lcol = Range("IV3").End(xlToLeft).Column

c = 3
Set rng1 = Range(Cells(3, 1), Cells(3, lcol))

'// Find Row No. for Present Value
PVrw = Application.WorksheetFunction.Match(" Present value = P", Range("A1:A" & Range("A65536").End(xlUp).Row), 0)

'// Loop through each col
Do While c < lcol
c = c + 2
Col_Name = rng1.Cells(1, c)


RELEVANT CODE


'//Determine last row of historical data file (this workbook sheet1 col D)
Lastrow = Cells((Cells(65536, c + 1).End(xlUp).Row), c).End(xlUp).Row
Nextrow = Lastrow + 1

'//Determine date of last historical data entry
Lastdate = Cells(Lastrow, 1).Value
Lastdate = Format(Val(Format(Cells(Lastrow, 1), "general number")), "d-mmm-yy")
'//Locate, open & activate downloaded csv data file
'Source_Data_File = Directory & "Update_" & Col_Name & ".csv" 'Full path and name of csv file
Source_Data_File = Directory & Col_Name & ".csv" 'Full path and name of csv file
'above line = old set up - searched for all files starting with "Update_"

Workbooks.Open (Source_Data_File)

'deletes headers - unneccessary rows
ActiveSheet.Rows("1:3").Delete

'//Format dates in Column A of csv file
'ActiveSheet.Columns("A").NumberFormat = "mmm-yyyy"


'sorts data
ActiveSheet.Columns("A:F").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending

'//Determine date of most up-to-date closing price in csv file
lastquotedate = ActiveSheet.Cells(2, 1).Value
Latestdate = DateValue(lastquotedate)

'// Locate corresponding position in csv file of last price in historical data workbook

With Worksheets(1).Range("A1:A1000")
Set Rw = .Find(Lastdate, LookIn:=xlValues)
stpt = Rw.Address
End With

'// Activate csv file for copy
Workbooks(Col_Name & ".csv").Activate

'// Copy later data from International Index csv files
Range(stpt).Offset(-1, 0).Select
If ActiveCell.Row < 2 Then
MsgBox ("Data for Index " & Col_Name & " is up to date")
GoTo Close_out
Else
vcol = 2
Workbooks(ThisWorkbook.Name).Sheets("table").Activate
Cells(Nextrow, c).Select
While Range("A" & ActiveCell.Row).Value <= Latestdate
Nextrow = ActiveCell.Row
'ActiveCell.Formula = "=VLookup(A" & ActiveCell.Row & ",'Update_" & Col_Name & ".csv'!$A:$E,2,0)"
ActiveCell.Formula = "=VLookup(A" & ActiveCell.Row & ",'" & Col_Name & ".csv'!$A:$E,2,0)"

'above line tells it which column to bring back data from '$A:$E,2,0' tells it to bring back col 2
If IsError(ActiveCell) Then
ActiveCell = ""
Else
ActiveCell = ActiveCell.Value
Cells(PVrw, c) = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Wend
End If

'// paint format down new data
Workbooks(ThisWorkbook.Name).Activate
Sheets("Table").Select

Cells(Lastrow, c).Select
Range(ActiveCell, ActiveCell).Select
Selection.AutoFill Destination:=Range(ActiveCell, Cells(Nextrow, c)), Type:=xlFillFormats