VBA Loop to Accumulate Data

Question

I have a file that I get everyday/everyweek. First I test if the file is available in the directory, if it is not then I go to "data tracker" and make value of Range B2 "Missing" in that sheet. I am getting a

run time error 1004

in that section. Please help.

If the file is available then I need to copy B2 of the opening workbook and I need to paste it into my macro book Column A, if Column A already have values then it will paste in the next available/empty cell/row in column A of my macro book. That section might be wrong too, hoping an expert can help.

Application.AskToUpdateLinks = False
Application.ScreenUpdating = False

Dim FilePath As String
Dim TestStr As String

Dim WBA As Workbook 'Opened Workbook


FilePath = "C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary"

TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0

If TestStr = "" Then     
    Workbooks("FullAuto Final.xlsm").Activate
    Worksheets("Data Tracker").Range("B2").Select
    Selection.Value = "Missing"
Else
    Workbooks.Open "C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary"

    Set WBA = ActiveWorkbook        
    WBA.Application.CutCopyMode = False

    'Select and Copy Site Name
    WBA.Sheets(1).Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy Destination:=ThisWorkbook.Worksheets(1).Range("A:A" & Cells(Rows.Count, "A:A").End(xlUp).Row)

    WBA.Close SaveChanges:=False
    ThisWorkbook.Activate
    Worksheets("Data Tracker").Range("A2").Value = "Complete"

End If

Application.AskToUpdateLinks = True
Application.ScreenUpdating = True

End Sub

(1) Is the workbook "FullAuto Final.xlsm" open at the time the code tries to Activate it? (2) If so, does that workbook contain a sheet called "Data Tracker"? (3) Why don't you just write Workbooks("FullAuto Final.xlsm").Worksheets("Data Tracker").Range("B2").Value = "Missing"? (You should avoid using Select whenever possible. It leads to too many issues.) — YowE3K
– YowE3K, Commented Aug 18, 2016 at 4:38
One thing I noticed is that you will need to change TestStr = Dir(FilePath) to TestStr = Dir(FilePath & "\*.*") otherwise it won't find any files to process. (But that doesn't explain why you are getting the error when it correctly/incorrectly decides that there are no files to process.) — YowE3K
– YowE3K, Commented Aug 18, 2016 at 4:54
I fixed it by. Rng.Copy Destination:=ThisWorkbook.Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0) — ASE Dev
– ASE Dev, Commented Aug 18, 2016 at 15:43

Shai Rado · Accepted Answer · 2016-08-18 16:07:39Z

1

Try the edited code below:

Sub OpenFileFolder()


Dim WBA                 As Workbook 'Opened Workbook
Dim FilePath            As String
Dim TestStr             As String
Dim FileExtension       As String
Dim lastRow             As Long
Dim Rng                 As Range

Application.AskToUpdateLinks = False
Application.ScreenUpdating = False

FilePath = "C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary\"
FilePath = "C:\"
' can modify it to filter only Excel files
FileExtension = "*"

TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath & FileExtension)
On Error GoTo 0

' file found
If Len(TestStr) > 0 Then
    Set WBA = Workbooks.Open(Filename:=FilePath & TestStr)

    WBA.Application.CutCopyMode = False

    ' find last row in Column B in WBA Sheets(1)
    lastRow = WBA.Sheets(1).Cells(WBA.Sheets(1).Rows.Count, "B").End(xlUp).Row

    ' Set Range of cells to copy
    Set Rng = WBA.Sheets(1).Range("B2:B" & lastRow)

    Rng.Copy Destination:=ThisWorkbook.Sheets(1).Range("A" & ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, "A").End(xlUp).Row + 1)

    WBA.Close (False)
    ThisWorkbook.Activate
    Worksheets("Data Tracker").Range("A2").Value = "Complete"

Else ' file not found
    Workbooks("FullAuto Final.xlsm").Worksheets("Data Tracker").Range("B2").Value = "Missing"
End If

Application.AskToUpdateLinks = True
Application.ScreenUpdating = True

End Sub

edited Aug 18, 2016 at 16:07

answered Aug 18, 2016 at 5:53

Shai Rado

33.7k7 gold badges32 silver badges55 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

ASE Dev Over a year ago

The workbook is still not found even the file does exist in C:\Users\anthonyer\Documents\Automation VBA\Source

ASE Dev Over a year ago

I take that back, it does work(I had misspelled the file name in the Dir), However, it overwrites A1 of the destination sheet, I am stepping through the code now to fix this. Thank you all for your support. I am so happy to be a member of stackoverflow. I am an aspiring coder in python and VBA who is solving real world problems, and I really really appreciate the support.

ASE Dev Over a year ago

-I updated the code to match my reporting, but I having an issue with the following section of the code. Rng.Copy Destination:=ThisWorkbook.Sheets(2).Range("A" & ThisWorkbook.Sheets(2).Cells(ThisWorkbook.Sheets(2).Rows.Count, "A").End(xlUp).Row) - is overwriting the headers I have placed.

Chrowno · Accepted Answer · 2016-08-18 04:35:46Z

0

FilePath = "C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary"

TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0

This error handle works as follows: If there is an error with TestStr = Dir(FilePath), ignore it and move on in the code. Proper error handling work like this:

FilePath = "C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary"

TestStr = ""
On Error GoTo ErrHandler
TestStr = Dir(FilePath)
On Error GoTo 0

'Code if no Error occurs
Exit Sub

ErrHandler:
'Code if Error occurs.
Resume Next 'if you want to return to the code
End Sub

However testing if an error exist with an Error Handler is rather ugly. You could use the FileSystemObject library to test for the file. For this you need to activate it first. Go to Tools -> References and check Microsoft Scripting Runtime.

To check for the file. there is a neat method available in this library:

Dim fsoFile as Scripting.FileSystemObject

Set fsoFile = New Scripting.FileSystemObject 'Instancing

If Not fsoFile.FileExists("C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary") Then

Now, your runtime error is mostlikely produced by Worksheets("Data Tracker") as there can't be any spaces in Sheet names. Furthermore, in VBA there is never a need to select a cell. Go on like this instead:

Workbooks("FullAuto Final.xlsm").Worksheets("DataTracker").Range("B2").Value = "Missing"

Else
'Do other stuff if the file exists
End if
End sub

answered Aug 18, 2016 at 4:35

Chrowno

1986 bronze badges

5 Comments

YowE3K Over a year ago

Sheet names can contain spaces.

YowE3K Over a year ago

Also FileExists will return False even if the directory you are testing for does exist. (It only returns True if a file exists.) You need to use FolderExists to check for the existence of a directory.

Chrowno Over a year ago

Ugh. Good morning me. Ye they can. Usually working with codenames so...If this still gives an error, it would be nice to know from which workbook you are running the code and which line of code produces it. Step through the code with F8

Chrowno Over a year ago

Well he said he wanted to test for the file. Only thing missing is the file name after directory e.g. If Not fsoFile.FileExists("C:\Users\anthonyer\Documents\Automation VBA\Source\Comcast Secondary[Filename]")

YowE3K Over a year ago

LOL - We should always avoid answering questions first thing in the morning! :-)

Collectives™ on Stack Overflow

VBA Loop to Accumulate Data

2 Answers 2

3 Comments

5 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

5 Comments

Your Answer

Sign up or log in

Post as a guest

Related