Open and copy all data from from dat file in a specified folder, but exclude if file name listed in worksheet

[goeman]

Hello there

I have a vba code which works perfectly... it opens and copys all data from any DAT file located in a specified folder (C:\Junk) to a worksheet called 'download' and also stores the name of any DAT file it has processed in a worksheet called 'Processed_Files'

However I need the macro not to open and copy the data if the name of the DAT file is already listed in the worksheet 'Processed_Files'

The VBA code I have is as follows:

Sub Part_1_0_MergeDataFromWorkbooks()

'DECLARE AND SET VARIABLES

Dim wbk As Workbook
Dim wbk1 As Workbook
Set wbk1 = ThisWorkbook
Dim Filename As String
Dim Path As String
Path = "C:\Junk" 'CHANGE PATH

Filename = Dir(Path & "*.dat")


'OPEN EXCEL FILES

Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)

wbk.Activate

     On Error Resume Next
     Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("EccoAdmin NPS Survey.xlsb").Activate
Application.DisplayAlerts = False
Dim lr As Double
lr = wbk1.Sheets("Download").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Download").Select
Cells(lr + 1, 1).Select
ActiveSheet.Paste
wbk.Close True
Filename = Dir

Loop

      Sheets("Processed_Files").Select
      
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
Dim F As String
F = Dir("C:\Junk" & "*.dat")
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir()
Loop

End Sub

Thanks for your help

 

[goeman]

actually a separate code which deletes all DAT files listed in the worksheet, may also work..


Thanks

 

[Fluff]

Try

Sub Part_1_0_MergeDataFromWorkbooks()

'DECLARE AND SET VARIABLES

Dim wbk As Workbook
Dim wbk1 As Workbook
Dim Fname As String
Dim Pth As String
Dim Ary As Variant

Pth = "C:\Junk\" 'CHANGE Pth
Set wbk1 = ThisWorkbook
Fname = Dir(Pth & "*.dat")
With wbk1.Sheets(Processed_Files)
   Ary = Application.Transpose(.Range("A2", .Range("A" & Rows.Count).End(xlUp)))
End With

'OPEN EXCEL FILES

Do While Len(Fname) > 0 'IF NEXT FILE EXISTS THEN
   If Not UBound(Filter(Ary, Pth & Fname, True, vbTextCompare)) > 0 Then
      Set wbk = Workbooks.Open(Pth & Fname)
      wbk1.Sheets(Processed_Files).Range("A" & Rows.Count).End(xlUp).Offset(1).Value = wbk.FullName

      wbk.Activate
      
     On Error Resume Next
     Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

      Range("A2").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      Windows("EccoAdmin NPS Survey.xlsb").Activate
      Application.DisplayAlerts = False
      Dim lr As Double
      lr = wbk1.Sheets("Download").Cells(Rows.Count, 1).End(xlUp).Row
      Sheets("Download").Select
      Cells(lr + 1, 1).Select
      ActiveSheet.Paste
      wbk.Close True
   End If

   Fname = Dir
Loop

End Sub

 

[goeman]

thanks for the fast reply.... but unfortunately code still opens data file that are listed

 

[Fluff]

with this

Sub Part_1_0_MergeDataFromWorkbooks()

'DECLARE AND SET VARIABLES

Dim wbk As Workbook
Dim wbk1 As Workbook
Dim Fname As String
Dim Pth As String
Dim Ary As Variant

Pth = "C:\Junk\" 'CHANGE Pth
Set wbk1 = ThisWorkbook
Fname = Dir(Pth & "*.csv")
With wbk1.Sheets("Processed_Files")
   Ary = Application.Transpose(.Range("A2", .Range("A" & Rows.Count).End(xlUp)))
End With

'OPEN EXCEL FILES

Do While Len(Fname) > 0 'IF NEXT FILE EXISTS THEN
MsgBox Pth & Fname
   If Not UBound(Filter(Ary, Pth & Fname, True, vbTextCompare)) > 0 Then
      Set wbk = Workbooks.Open(Pth & Fname)
      wbk1.Sheets("Processed_Files").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = wbk.FullName

      wbk.Activate
      
     On Error Resume Next
     Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

      Range("A2").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      Windows("EccoAdmin NPS Survey.xlsb").Activate
      Application.DisplayAlerts = False
      Dim lr As Double
      lr = wbk1.Sheets("Download").Cells(Rows.Count, 1).End(xlUp).Row
      Sheets("Download").Select
      Cells(lr + 1, 1).Select
      ActiveSheet.Paste
      wbk.Close True
   End If

   Fname = Dir
Loop

End Sub

Step through the code using F8 & it will show a message box with the Path/filename.
Does that look like the data you have in col A of the Processed_Files sheet?

 

[goeman]

Hi

Stepping through the latest vba this one doesent seem to open any file?

when at code below it then goes straight to 'End Sub' even though files that are not listed are in C:\Junk

Do While Len(Fname) > 0 'IF NEXT FILE EXISTS THEN




Thanks

 

[goeman]

sorry also and yes file names are correct.. ive also tried adding the file location and name in list

 

[Fluff]

Forgot to change this from csv after testing

Fname = Dir(Pth & "*.dat")

 

[goeman]

Forgot to change this from csv after testing

Fname = Dir(Pth & "*.dat")

Of course!.... I missed that as well...

Anyway bit of a strange one, does seem to work..... well sort of.

on the first run it will process the file as it should and the file name is copied to the 'Processed_File' tab, if I run macro again it will still open process the same dat file again, even though the dat file name is listed? (file name will be duplicated in the 'Processed_File' tab) however if I then run macro again for the 3rd time onwards it will work, it will see the file name is listed and does not process the data?

 

[goeman]

sorry, just to confirm the only problem with the macro is the name of the dat file has to be listed twice in the 'Processed_File' tab for it to ignore processing the same dat file again...