create a macro to change a date from "mm/dd/yy" to "yyyy"

[TSpringer]

We use a macro is excel that requires the date to be in yyyy format. If I simply change the date format that we receive from our customer, to the format yyyy, when you click on the cell it still shows the original format at the top.

I am trying to set a format or a macro that will change the dates I have previously copied from our client's fixed asset listings, to a yyyy input.

How can I set this up so that it will change it for me so that I do not have to manually change each of 1,000+ entries?

Is this possible? I am not highly expereinced with macros but have done some reading about them today.

I appreciate any help you may be able to provide.

Kindly,

TSpringer​

 

[Jeff Meyers]

Welcome to the Mr Excel forums.

You do not need to use a Macro to change / extract the year as a value / number. You can do it with a formula as follows:

Sheet1

	A	B
1	Date	Year
2	07/04/2010	2010
3	11/06/2011	2011
4	06/30/2012	2012
5
6
7	------------------	------------
8

<thead>
</thead><tbody>
</tbody>

Excel 2010

Worksheet Formulas Cell Formula B2 =--TEXT(A2,"yyyy") B3 =--TEXT(A3,"yyyy") B4 =--TEXT(A4,"yyyy") <thead> </thead><tbody> </tbody>

<tbody>
</tbody>

 

[AlphaFrog]

Hi and welcome to the forum.

Can you post your existing macro that uses the yyyy format. It could be modified to extract the year from your date entries.

Or this formula would extract the year from a date value.

=YEAR(A1)

 

[TSpringer]

Will I need to do this for every cell? I am trying to avoid having to address each one individuall since there are 1,000.

 

[TSpringer]

Thanks, but will I need to use that formula to extract the year for each cell individuall? There are 1,000 that need extracted. Or, do I enter that somewhere in the macro. I will reply again with the macro I am using. Thanks!

 

[TSpringer]

Is this below, what you are referring to? This is the macro we run to calculate what I am trying to do and if the year in a particular column (AI) is not in yyyy format, it will not work.

Thanks!




CalculateOriginal Macro
' Macro Modified 9/2/99 by Cindy Hendon
'
'
Sub CalculateOriginal()


X = 6
Range("K1").Select
TaxYear = ActiveCell.Formula

Do
Range("AI" & X).Select
If ActiveCell.Formula <> Empty Then

Range("AJ" & X).Select
ChangeAmount = ActiveCell.Value
Range("AI" & X).Select
ChangeYear = ActiveCell.Value
Range("AK" & X).Select
ChangeType = ActiveCell.Formula


Select Case ChangeType
Case "A"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (6 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "B"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (26 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "D"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("I" & (6 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "F"
If ChangeYear < TaxYear - 8 Then ChangeYear = TaxYear - 8
Range("I" & (42 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "AI"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (75 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "BI"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (95 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "DI"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("I" & (74 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "FI"
If ChangeYear < TaxYear - 8 Then ChangeYear = TaxYear - 8
Range("I" & (111 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "AL"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (135 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "BL"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (155 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "DL"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("I" & (135 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
Case "FL"
If ChangeYear < TaxYear - 8 Then ChangeYear = TaxYear - 8
Range("I" & (156 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount
End Select
Else: i = 1
End If

X = X + 1

Loop Until i = 1
End Sub
'
' Date_Change Macro
' Macro recorded 5/25/95 by Tony Stauffer
'
'
Sub Date_Change()

X = 5
Do
Range("AY" & X).Select
OldDate = ActiveCell.Value
NewDate = Mid(OldDate, Len(OldDate) - 1, 2)
NewDate = NewDate + 1900
ActiveCell.Value = NewDate
X = X + 1
Loop Until X = 464
End Sub
'
' Year_Plus_One Macro
' Macro recorded 10/31/96 by Cindy
'
'
Sub Year_Plus_One()
'To add a year
Range("K1").Select
X = ActiveCell.Value
Range("K1").Select
ActiveCell.Value = X + 1

'Average Lived Original F&F (Schedule A)

'To add the last two lines

ActiveWindow.SmallScroll Down:=11
Range("C21").Select
X = ActiveCell.Value
Range("C20").Select
y = ActiveCell.Value
Range("C21").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("C6:C19").Select
Selection.Copy
Range("C7:C20").Select
ActiveSheet.Paste
'Delete first line

Range("C6").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=20


'Average Lived Original M&E (Schedule B)

'To add the last two lines

ActiveWindow.SmallScroll Down:=11
Range("C41").Select
X = ActiveCell.Value
Range("C40").Select
y = ActiveCell.Value
Range("C41").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("C26:C39").Select
Selection.Copy
Range("C27:C40").Select
ActiveSheet.Paste
'Delete first line

Range("C26").Select
Selection.ClearContents
ActiveWindow.SmallScroll ToRight:=6
ActiveWindow.SmallScroll Up:=35


'Average Lived Original Office Machines (Schedule O)

'To add the last two lines

ActiveWindow.SmallScroll Down:=11
Range("I21").Select
X = ActiveCell.Value
Range("I20").Select
y = ActiveCell.Value
Range("I21").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("I6:I19").Select
Selection.Copy
Range("I7:I20").Select
ActiveSheet.Paste
'Delete first line

Range("I6").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=36

'Average Lived Original Computers (Schedule F)

'To add the last two lines

ActiveWindow.SmallScroll Down:=12
Range("I49").Select
X = ActiveCell.Value
Range("I48").Select
y = ActiveCell.Value
Range("I49").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("I42:I47").Select
Selection.Copy
Range("I43:I48").Select
ActiveSheet.Paste
'Delete first line

Range("I42").Select
Selection.ClearContents
ActiveWindow.SmallScroll ToRight:=7

'Revised Average Lived F&F (Schedule A)

'To add the last two lines

ActiveWindow.SmallScroll Down:=11
Range("AW21").Select
X = ActiveCell.Value
Range("AW20").Select
y = ActiveCell.Value
Range("AW21").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("AW6:AW19").Select
Selection.Copy
Range("AW7:AW20").Select
ActiveSheet.Paste
'Delete first line

Range("AW6").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=20

'Revised Average Lived M&E (Schedule B)

'To add the last two lines

ActiveWindow.SmallScroll Down:=11
Range("AW41").Select
X = ActiveCell.Value
Range("AW40").Select
y = ActiveCell.Value
Range("AW41").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("AW26:AW39").Select
Selection.Copy
Range("AW27:AW40").Select
ActiveSheet.Paste
'Delete first line

Range("AW26").Select
Selection.ClearContents
ActiveWindow.SmallScroll ToRight:=6
ActiveWindow.SmallScroll Up:=35


'Revised Average Lived Office Machines (Schedule O)

'To add the last two lines

ActiveWindow.SmallScroll Down:=11
Range("BC21").Select
X = ActiveCell.Value
Range("BC20").Select
y = ActiveCell.Value
Range("BC21").Select
ActiveCell.Value = X + y
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=2
'To move the range down

Range("BC6:BC19").Select
Selection.Copy
Range("BC7:BC20").Select
ActiveSheet.Paste
'Delete first line

Range("BC6").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=36

'Revised Computer & Peripheral Equipment (Schedule F)

ActiveWindow.SmallScroll ToRight:=6
ActiveWindow.SmallScroll Down:=-8
'To add the last two lines

Range("BC49").Select
X = ActiveCell.Value
Range("BC48").Select
y = ActiveCell.Value
Range("BC49").Select
ActiveCell.Value = X + y
'To move the range down

Range("BC42:BC47").Select
Selection.Copy
Range("BC43:BC48").PasteSpecial (xlValues)

'Delete first line
Range("BC42").Select
Selection.ClearContents
End Sub

 

[AlphaFrog]

Add the one line in red to your macro.

Range("AJ" & X).SelectChangeAmount = ActiveCell.Value
Range("AI" & X).Select
[COLOR=#ff0000]If IsDate(ActiveCell) Then ActiveCell.Value = Year(ActiveCell.Value)[/COLOR]
ChangeYear = ActiveCell.Value
Range("AK" & X).Select
ChangeType = ActiveCell.Formula

It converts each date value in column AI to yyyy

 

[TSpringer]

OK, I added that..when I opened my macro though, it had another line above "Change Year" that said "Change Amount". I couldn't find anywhere else you would have been talking about though so I added the line that was in red, rean the macro and it's began to do it's thing and then gave me a Runtime Error '1004' Method Range of object_Global failed

When I debug it, it show's me this (I put the line they had highlighted, in red)

Case "B"
If ChangeYear < TaxYear - 16 Then ChangeYear = TaxYear - 16
Range("C" & (26 + (TaxYear - ChangeYear - 1))).Select
ActiveCell.Value = ActiveCell.Value + ChangeAmount

Thanks for taking the time to help me! I really appreciate it!

 

[TSpringer]

Also, it shows it is under B because that is the first group of lettered labels it comes to so if it does what it was doing last time, it will give me an error down through every entry, starting with Bs since they are at the top of the list.

 

[AlphaFrog]

Lets try this again. Add the line in red.

Do
Range("AI" & X).Select
If ActiveCell.Formula <> Empty Then


Range("AJ" & X).Select
ChangeAmount = ActiveCell.Value
Range("AI" & X).Select
If IsDate(ActiveCell) Then ActiveCell.Value = Year(ActiveCell.Value)
ChangeYear = ActiveCell.Value
Range("AK" & X).Select
ChangeType = ActiveCell.Formula


Is that where you added the new red line?

On the sheet, do you see the dates converted to yyyy ?