ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Help with macro (https://www.excelbanter.com/excel-discussion-misc-queries/64164-help-macro.html)

nc

Help with macro
 
The following macro list the file names in a specific directory on to a
worksheet named "TAS forms received" in column A and row 1. Each time it is
run overwrites the list.

What do I need to add to the macro so that the prior list is never
overwritten but the new file names in the directory are added at the end of
the list.

Thanks.


Private Sub Worksheet_Activate()

Dim FN As String ' For File Name
Dim ThisRow As Long
Dim FileLocation As String
Dim newWks As Worksheet


Set newWks = Worksheets("TAS forms received")

Application.ScreenUpdating = False



FileLocation = "F:\Finance\Transparency\Data collection\TAS forms
received\*.xls"

FN = Dir(FileLocation)
Do Until FN = ""
ThisRow = ThisRow + 1
newWks.Cells(ThisRow, 1) = FN
FN = Dir
Loop

Application.ScreenUpdating = True

End Sub






Bernie Deitrick

Help with macro
 
nc,

Change

FN = Dir(FileLocation)
Do Until FN = ""
ThisRow = ThisRow + 1
newWks.Cells(ThisRow, 1) = FN
FN = Dir
Loop


to

FN = Dir(FileLocation)
Do Until FN = ""
If IsError(Application.Match(FN, newWks.Range("A:A"), False)) Then
newWks.Cells(Rows.Count, 1).End(xlUp)(2).Value = FN
End If
FN = Dir
Loop

HTH,
Bernie
MS Excel MVP


"nc" wrote in message
...
The following macro list the file names in a specific directory on to a
worksheet named "TAS forms received" in column A and row 1. Each time it is
run overwrites the list.

What do I need to add to the macro so that the prior list is never
overwritten but the new file names in the directory are added at the end of
the list.

Thanks.


Private Sub Worksheet_Activate()

Dim FN As String ' For File Name
Dim ThisRow As Long
Dim FileLocation As String
Dim newWks As Worksheet


Set newWks = Worksheets("TAS forms received")

Application.ScreenUpdating = False



FileLocation = "F:\Finance\Transparency\Data collection\TAS forms
received\*.xls"

FN = Dir(FileLocation)
Do Until FN = ""
ThisRow = ThisRow + 1
newWks.Cells(ThisRow, 1) = FN
FN = Dir
Loop

Application.ScreenUpdating = True

End Sub









All times are GMT +1. The time now is 01:53 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com