Add File Name as column in two sheets

[swathidas]

Hi ,

I have a folder C:\DataFiles, in this folder I have around 300 files, in each xls file there are two tabs Dev and Test.

I am trying to add a new column in both the sheets.

In Dev worksheet I have to create a filename in column F and in Test I have to create filename in column N.

Right now I am doing it manually, what I thought was I will use theActiveWorkbook.Name function to get the filename and fill it , I have created the below macro.

Sub add_file()
Range("F:F").Formula = ActiveWorkbook.Name
End Sub

Please tell me how can I
a) add the filename to the columns as per the data present.(please see the atatchment), right now this macro is adding filename to all the columns in the xls.
b)how to call this function in both the sheets so that the filename will be inserted.

Thanks,
Swathi Das

[tigeravatar]

swathidas,

Give the following a try:

Sub tgr()
    
    Const strFldrPath As String = "C:\DataFiles\"
    
    Application.ScreenUpdating = False
    Dim CurrentFile As String: CurrentFile = Dir(strFldrPath & "*.xls*")
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Col As String
    
    While CurrentFile <> vbNullString
        Set wb = Workbooks.Open(strFldrPath & CurrentFile)
        For Each ws In wb.Sheets
            If ws.Name = "Dev" Or ws.Name = "Test" Then
                Select Case ws.Name
                    Case "Dev":  Col = "F"
                    Case "Test": Col = "N"
                End Select
                Intersect(ws.UsedRange.Offset(1).Resize(ws.UsedRange.Rows.Count - 1), ws.Columns(Col)).Value = wb.Name
            End If
        Next ws
        wb.Close False
        CurrentFile = Dir
    Wend
    
    Application.ScreenUpdating = True
    
End Sub

[swathidas]

Hi,

Thanks for the macro, I executed it but the macro did not add the file names in the xls files.

Thanks,
Swathi Das

[tigeravatar]

swathidas,

Heh, turned out it wasn't saving the changes >_< Try it this way where is does save the changes:

Sub tgr()
    
    Const strFldrPath As String = "C:\DataFiles\"
    
    Application.ScreenUpdating = False
    Dim CurrentFile As String: CurrentFile = Dir(strFldrPath & "*.xls*")
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Col As String
    
    While CurrentFile <> vbNullString
        Set wb = Workbooks.Open(strFldrPath & CurrentFile)
        For Each ws In wb.Sheets
            If ws.Name = "Dev" Or ws.Name = "Test" Then
                Select Case ws.Name
                    Case "Dev":  Col = "F"
                    Case "Test": Col = "N"
                End Select
                Intersect(ws.UsedRange.EntireRow.Offset(1).Resize(ws.UsedRange.Rows.Count - 1), ws.Columns(Col)).Value = wb.Name
            End If
        Next ws
        wb.Close True
        CurrentFile = Dir
    Wend
    
    Application.ScreenUpdating = True
    
End Sub

[swathidas]

Hi,

Where should I set this option in the code.

Thanks,
Swathi Das

[tigeravatar]

swathidas,

i'm not sure what you mean. If you mean the option to save the changes, its the wb.Close True line. The True indicates that we do want to save changes. In the prior code it was wb.Close False which indicates that we do not want to save changes, which was incorrect.

[swathidas]

Hey,

I am sorry , i got it. Thanks a lot.

Thanks,
Swathi Das