PDA

View Full Version : How to add date column in workbook files



JackkG
01-04-2015, 06:55 AM
Hi,


I've got around 100+ excel workbooks in a folder, I got to add date column to the sheet and insert the date that is attached with the file name (eg: Stock20140120.xls), it will be the first column. The inserted date will be through the end of the column data in Column B. Its very tedious to do it manually, is there any way we can do it through macro or something?


Any help?


Thanks!

SamT
01-04-2015, 08:23 AM
Are all the files named "Stock" + Date?
How do you want the dates in column A formatted?
What is the full path to the Folder?
Will you have to do this on every new "Stock" folder or is this for one time only?

gmayor
01-04-2015, 08:31 AM
You can certainly do it with a macro e.g.

Loop through all the workbooks in the folder and call the macro AddDateCol. If you open one of your workbooks, you can test the function with the Test macro.

The code makes a few assumptions:
1. The sheet to be processed is the first sheet
2. If there is a header row change the number in the indicated line to 2 from 1
3. Was column B Column A before the addition of a new column? Or was it B originally. If it was B originally, change
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
to
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

If you need help with the process to loop through the files in the folder, let us know.



Option Explicit

Sub AddDateCol(xlBook As Workbook)
Dim xlSheet As Worksheet
Dim strName As String
Dim strDate As String
Dim LastRow As Long
Dim i As Long
strName = ExtractDigits(xlBook.Name)
strDate = Right(strName, 2) & "/" & Mid(strName, 2, 2) & "/" & Left(strName, 4)
If IsDate(strDate) Then
Set xlSheet = xlBook.Sheets(1) 'assumes the first sheet in the workbook
With xlSheet
.Range("A1").EntireColumn.Insert
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 'assumes the new column is A and B was formerly A
For i = 1 To LastRow 'Make that 2 is there is a header row
.Range("A" & i) = CDate(strDate)
Next i
End With
End If
lbl_Exit:
Exit Sub
End Sub

Private Function ExtractDigits(strFieldName As String) As String
Dim i As Integer
ExtractDigits = ""
For i = 1 To Len(strFieldName)
If Mid(strFieldName, i, 1) >= "0" And _
Mid(strFieldName, i, 1) <= "9" Then
ExtractDigits = ExtractDigits + Mid(strFieldName, i, 1)
End If
Next
lbl_Exit:
Exit Function
End Function

Sub TestMacro()
AddDateCol ActiveWorkbook
End Sub

JackkG
01-04-2015, 08:52 AM
Hi Sam,

Thanks for looking into it.

Yes all the files are named "Stock" + Date, and this is one time. The path, lets say: C:\Stockdata




Hi Gmayor,

Thanks for the code, will check out the code and will get back.

Thanks guys!!

JackkG
01-04-2015, 09:22 AM
Hi gmayor,

Your code works fine but it works only in the workbook in which the code resides. Can you help me modify the code so that the changes are done in all the excel files in that folder. There are around 100+ files. Any idea?

Thanks!!

SamT
01-04-2015, 03:39 PM
Try this. It compiles, but is not tested.

Option Explicit

Const StockFolder As String = "C:\StockData\" 'Edit to suit Needs last "\"

Sub AddDateColumnsToStockFolder()
'Assumes working on sheet(1) of all books
'Assumes Row 1 is header Row

Dim FileName As String
Dim TmpDate As String
Dim StockFile As Excel.Workbook

'For adjusting date formats
Dim Dy As String
Dim Mn As String
Dim Yr As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

FileName = Dir(StockFolder & "*.xls") 'Edit extension to suit

Do While Len(FileName) > 0
On Error GoTo NextFile
Workbooks.Open (StockFolder & FileName)

TmpDate = Mid(FileName, 6, Len(FileName) - 9) 'use -10 for ".xlsm" etc
Dy = Right(TmpDate, 2)
Mn = Mid(TmpDate, 2, 2)
Yr = Left(TmpDate, 4)
TmpDate = Dy & "/" & Mn & "/" & Yr 'Rearrange periods to suit
If Not IsDate(TmpDate) Then GoTo NextFile

With Workbooks(FileName).Sheets(1)
Range("A1").EntireColumn.Insert
Range(Range("A2"), Cells(Rows.Count, 2).End(xlUp).Offset(0, -1)) = TmpDate
End With
NextFile:
FileName = Dir("")
Loop

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
End With

End Sub