Extracting data from excel VBA

[leemcder]

Hi everyone, hoping someone can help me with a problem I've got.

The code below extracts data from multiple excel spreadsheets in a folder, works great for that. We than add extra data etc ourselves.

What I'd like is also an option to update the data, so any new excel documents added to the folder since the macro was run last run it will just add those to the bottom of the existing data. (I don't want to clear the data and populate the whole data again as we would lose any extra data we have added ourselves) Is anyone able to help with that please?

Many thanks

Sub ExtracData()

Dim summary As Workbook
Dim wb As Workbook
Dim directory As String
Dim fileName As String
Dim NextRow As Long




Application.DisplayAlerts = False
Application.ScreenUpdating = False


Set summary = ThisWorkbook
directory = summary.Worksheets("Sheet1").Range("A1")
fileName = Dir(directory & "*.xl??")


Do While fileName <> ""
    If fileName <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(directory & fileName)
        wb.Worksheets("data").Range("A1:G1").Copy
        summary.Activate
        NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Worksheets("Sheet1").Range("A" & NextRow).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Close savechanges:=False
    End If
    fileName = Dir
Loop


Application.DisplayAlerts = True
Application.ScreenUpdating = True




MsgBox "Updated"


End Sub

[SamT]

You will need that Sub to keep a list of files already extracted and add a function to it that ignores any file already listed

One method is:
Declare Module level Constant

Const ListCol As String = "L" 'Edit to suit your needs

Add to Sub ExtracData before FileName = Dir

Columns (ListCol).Cells(1) = ThisWorkbook.Name

Change:

If fileName <> ThisWorkbook.Name Then

To

If Not Listed(FileName) Then
   Cells(Rows.Count, ListCol).End(xlUp).Offset(1) = FileName

Add New Function

Private Function Listed(FileName As String) As Boolean
Dim List As Variant
Dim i as Long

List = Cells(1, ListCol).CurrentRegion.Value 'CurrentRegion require List of File Names be surrounded by empty cells

For i = 1 to Ubound(List)
       If List(i) = FileName Then
             Listed = True
             Exit Function
       End If
Next i
End Function

[leemcder]

You will need that Sub to keep a list of files already extracted and add a function to it that ignores any file already listed

One method is:
Declare Module level Constant

Const ListCol As String = "L" 'Edit to suit your needs

Add to Sub ExtracData before FileName = Dir

Columns (ListCol).Cells(1) = ThisWorkbook.Name

Change:

If fileName <> ThisWorkbook.Name Then

To

If Not Listed(FileName) Then
   Cells(Rows.Count, ListCol).End(xlUp).Offset(1) = FileName

Add New Function

Private Function Listed(FileName As String) As Boolean
Dim List As Variant
Dim i as Long

List = Cells(1, ListCol).CurrentRegion.Value 'CurrentRegion require List of File Names be surrounded by empty cells

For i = 1 to Ubound(List)
       If List(i) = FileName Then
             Listed = True
             Exit Function
       End If
Next i
End Function

Thank you for your help. I have also found an alternative work around. I added code at the end which deletes the .xlsx documents from the directory folder. This only leaves new .xlsx documents the next time the macro is run.