Excel VBA updating a master list from files in folder

Question

I'm new to VBA so please bear with me here.

I'm having some trouble with updating a master file (the KAM Account Plan) using files from a defined folder (we'll call it the 'upload folder').

What I'm trying to do is:

open the files contained in the upload folder one by one
match the account code in them (cell E5) against those that appear in the master file (column A)
- update the relevant cells in the same row if a match appears
- insert a whole new row with the information at the bottom if it doesn't
then use cells to make a folder path, send the checked file to it, and delete it from the upload folder
repeat for all files in the folder

What I have at the moment only seems to use ONLY the first file to update the master list, then everything else gets filed away and cleaned up without updating.

It's close to working, but I can't quite get that final step.

Here's what I have so far:

Sub KAMtemplateupload()
    Application.ScreenUpdating = False

    Dim wb As Workbook
    Dim y As Workbook
    Dim actrow As Integer

    Dim folderPath As String
    Dim filename As String

    folderPath = "C:\test\test\"

    filename = Dir(folderPath & "*.xlsx")
    Do Until filename = ""
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & filename)
        Set y = Workbooks.Open("C:\test\KAM - Account Plan spreadsheet template -sample.xlsx")

        actrow = y.Sheets("Sheet1").Cells(y.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Offset(1).Row

        Dim r As Variant
        Dim Lastrow As Long
        Dim rng As Range

        With y.Sheets("Sheet1")
            Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rng = .Range("A:A")
            r = Application.Match(wb.Sheets("Sheet1").Range("E5"), rng, False)
            If Not IsError(r) Then
                'update
                .Cells(CLng(r), 3).Value = wb.Sheets("Sheet1").Range("C6")
                .Cells(CLng(r), 4).Value = wb.Sheets("Sheet1").Range("E6")
            Else
                'new
                'name
                wb.Sheets("Sheet1").Range("C5").Copy
                y.Sheets("Sheet1").Range("B" & actrow).PasteSpecial xlPasteValues
                'acctcode
                wb.Sheets("Sheet1").Range("E5").Copy
                y.Sheets("Sheet1").Range("A" & actrow).PasteSpecial xlPasteValues
                'policytotal
                wb.Sheets("Sheet1").Range("C6").Copy
                y.Sheets("Sheet1").Range("C" & actrow).PasteSpecial xlPasteValues
                'membertotal
                wb.Sheets("Sheet1").Range("E6").Copy
                y.Sheets("Sheet1").Range("D" & actrow).PasteSpecial xlPasteValues

            End If
        End With

        Const MYPATH As String = "C:\test\test\"

        Dim part3 As String

        part3 = wb.Sheets("Sheet1").Range("E4").Value

        If Len(Dir(MYPATH & part3, vbDirectory)) = 0 Then
            MkDir MYPATH & part3
        End If

        wb.SaveCopyAs "C:\test\test\" & part3 & "\" & "ER group renewal notes - " & wb.Sheets("Sheet1").Range("C5") & ".xlsx"
        wb.ChangeFileAccess xlReadOnly
        Kill wb.FullName

        filename = Dir(folderPath & "*.xlsx")

    Loop

    Application.ScreenUpdating = True

End Sub

When I run it, I also get a prompt reading "Do you want to save the changes before changing file status?"

I gather that's some sort of complication with setting the ReadOnly status, but if I don't set it to ReadOnly then it won't let me kill the file.

Any help would be hugely appreciated.

Thanks!

Firstly, before the end of the loop, probably before the last `dir`, make sure you explicitly close the file with `wb.Close SaveChanges:=False` Secondly, I believe the second `Dir` call should just be `filename = Dir` see this example https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba. Try those things first — Nick.Mc, Jul 15 '18 at 05:26
also you should open the `Set y = Workbooks.Open...` just once (before the loop, no inside it) — S.Serpooshan, Jul 15 '18 at 05:39
Solar Mike - it's because I was worried about the kill command deleting the filed-away copy of the file, instead of the copy in the upload folder. SaveCopyAs was my attempt to stop it from doing that. — Tim Kellaway, Jul 15 '18 at 06:36
So, in my understanding if you use .saveas then there won't be a copy you need to kill... — Solar Mike, Jul 15 '18 at 07:54

Tim Kellaway · Accepted Answer · 2018-07-15T07:13:32.757

I tried Nick and S.Serp's suggested changes and they lead to a solution - thanks!

It seems explicitly closing off the update file with wb.Close SaveChanges:=False, and better placement of the Set code was what was missing.

Oddly, removing the longer reference from filename=Dir just before the loop closes causes it not to work in this case. It gives "Invalid procedure call or argument." Leave the longer reference in, however, and it works fine.

For reference, the changes to the code now read:

(Moving the Set command out of the loop)

Set y = Workbooks.Open("C:\test\KAM - Account Plan spreadsheet template -sample.xlsx")

Do Until filename = ""
     Set wb = Workbooks.Open(folderPath & filename)

and

(closing the workbook off)

wb.SaveCopyAs "C:\test\test\" & part3 & "\" & "ER group renewal notes - " & wb.Sheets("Sheet1").Range("C5") & ".xlsx"
wb.ChangeFileAccess xlReadOnly
kill wb.FullName
wb.Close SaveChanges:=False

    filename = Dir(folderPath & "*.xlsx")

    Loop

I'm a recent member, so there's a delay imposed of a few days to be able to check an answer. — Tim Kellaway, Jul 15 '18 at 20:50

Excel VBA updating a master list from files in folder

1 Answers1