CODEWITHSUNDEEP
vbaexcel
Sam
Sam

Reputation: 185

Extract years, months and days from columns to create an excel formatted date column

I basically want to extract the years, the months and the days from the corresponding columns and use them to create an excel formatted date column with VBA.

With screenshots, it should at first look like this: Excel Spreadsheet with Year Column and Date Column.

Whereas, ultimately, the year column should be removed with only the date column remaining (leaving aside the description) and containing the excel formatted dates. Excel Spreadsheet with Date Column only

Now, there might be an easier way to accomplish this task but the method I've undertaken is to:

  1. Insert two new columns to the right of the Date column
  2. Select the Date column and move over the months to the newly created column on the right by using the Text to Columns function
  3. Format the blank 2nd newly created column to the Date category
  4. Insert the date function into the cells of this blank column and autofill it to the cells below. More precisely, this date function is: =DATE(A2,MONTH(1&C2),B2)
  5. Copy this New Date Column and paste it back as values only for later purposes of sorting.
  6. Delete all other useless columns (year,month,day)

Though this is feasible with the excel interface, I'd like to accomplish this task with VBA and so I've already written quite a bit of code. Unfortunately, being a novice in VBA, I'm currently stuck at applying the formula at the final date column.

Before you take a look at my code, I'd also like to point out that I prompt the user to select the Description column as a reference column as it isn't always the case that the the year column is the first column or that the date column is the 2nd one. What is absolutely certain, however, is that to the left of the Description column, there is, respectively, the date and the year column.

Finally, if someone would also ameliorate my VBA code by solely allowing the formula to be applied to the first and last rows containing years or dates (same thing), I'd appreciate it.

I thank you all in advance.

Here below is my code

    Sub Macro1()

'Set variables
Dim DescRng As Range
Dim DayRng As Range
Dim MonthRng As Range
Dim YearRng As Range
Dim DateRng As Variant

'Obtain reference column with prompt
Set DescRng = Application.InputBox("Select Description Column", "Obtain Object Range", Type:=8)

'Create new columns from reference column
Columns(DescRng.Column).Insert Shift:=x1ToLeft
Columns(DescRng.Column).Insert Shift:=x1ToLeft

'Assign variables to columns
Set DateRng = DescRng.Offset(rowOffset:=0, columnOffset:=-1)
Set MonthRng = DescRng.Offset(rowOffset:=0, columnOffset:=-2)
Set DayRng = DescRng.Offset(rowOffset:=0, columnOffset:=-3)
Set YearRng = DescRng.Offset(rowOffset:=0, columnOffset:=-4)

'Seperate the days from the months with TextToColumns
Columns(DayRng.Column).TextToColumns Destination:=DayRng, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

'Format the DateRng column for later sorting use
Columns(DateRng.Column).NumberFormat = "yyyy-mm-dd"

'Apply Formula to DateRng Column


'Copy Formula in DateRng and paste into the same column as values
Columns(DateRng.Column).Copy
Columns(DateRng.Column).PasteSpecial Paste:=xlPasteValues, SkipBlanks _
        :=False, Transpose:=False

'Delete the other Columns (YearRng, MonthRng, DayRng)
YearRng.Delete
DayRng.Delete
MonthRng.Delete

End Sub

Edit: I'm grateful for the insight your answers have brought. You've made possible a simple task with a short code, unlike my unfinished one. Learned a lot from my first post. Thanks

Upvotes: 1

Views: 1935

Answers (2)

urdearboy
urdearboy

Reputation: 14580

I took a different approach than @Jeeped so I figured i'd share since I took the time to practice with your question anyway. You will just need to format Col A with desired date format. 

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim DayMonth As Variant

ws.Columns("A:A").Insert: ws.Range("A1") = "Date"

For i = 2 To ws.Range("B" & ws.Rows.Count).End(xlUp).Row
    DayMonth = Split(ws.Range("C" & i), Chr(32))
    ws.Range("A" & i) = DateValue(DayMonth(0) & Chr(32) & Month(1 & DayMonth(0)) & Chr(32) & ws.Range("B" & i) & Chr(32))
Next i

ws.Columns("A:A").AutoFit
ws.Columns("B:C").Delete

Upvotes: 1

user4039065
user4039065

Reputation:

Try creating a valid string date with the displayed values from columns A and B.

with worksheets("sheet1")
    for i=2 to .cells(rows.count, 1).end(xlup).row
        .cells(i, 1) = datevalue(.cells(i, 2).text & ", " & .cells(i, 1).text)
        .cells(i, 1).numberformat = "yyyy-mm-dd"
    next i
    .columns(2).entirecolumn.delete
    .cells(1, 1) = "date"
end with

Upvotes: 1

Related Questions