Handling multiple files in macro

[PaulS]

Hi to all experts,
I have a problem to be solved that is probably easy for an expert. I can make a simple macro – in most cases based on a recorded macro. For this is typical VBA programmers knowledge required.
Description of my problem:
I have a workbook (database) with the following contents:
First tab (worksheet) contains documentation and a list of organisations (with ‘shortname’ in col N rows 200 to 340 - last can vary by year). Col O contains a “0” = not yet processed and “1” = data has been processed.
Per organisation the data is saved in a worksheet (name equal to ‘shortname’).
Every year all organisations are sent a questionnaire (excel sheet). Answers have to be entered in col E rows 12 to 40. When xls files have been returned (over e period of about 4 weeks), the answers have to be copied to the specific worksheet in my database. All in same col and rows. All returned data is used for later analysis.
I know how to copy data in a macro, but my problem is in reading the files – and handling files not found. I like to make a macro for this problem because the whole exercise is performed twice per year.
I ‘designed’ the flow of statements in the macro as something like: (if you have a better idea then I am happy to accept that …!)

Find first (N200) and last shortname
Do until last shortname has been processed
If col O contains “1” then goto nextfile (this file has been processed in previous run)
Make filename with this shortname (filename = year_n_shortname; n can be 1 or 2)
Open filename (‘Answersheet’ - all files are in same directory)
If filename found Then
Enter “1” in col O ( database/sheet1 - next to shortname) – this to indicate
that this ‘shortname’ has returned an answer
Activate Databaseworksheet (shortname)
Copy col E 12 to 40 of answersheet(shortname) to col M rows 12 to 40 in
Databaseworksheet (shortname)
Close this Filename (Answersheet).
EndIf
Nextfile:
Col N row +1
Loop

As said before my problem is the VBA coding for handling files (open – recognising found/not found) – copying data to proper database worksheet.
Thanks for your help
Paul

 

[AlphaFrog]

Try something like this...

Sub Update_Answers()

    Dim sFile As String, sPath As String, n As Integer
    Dim rngShorts As Range, rShortName As Range
    Dim wbAnswer As Workbook, wsShortName As Worksheet
    
    ' Set up the File path Dialog
    ' Requires reference to Microsoft Office 12.0 Object Library
    '    From the VBA menu, Select TOOLS\ REFERENCES and check the "Office xx.0 Object Library" checkbox
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show = True Then
            sPath = .SelectedItems(1)
            ChDir .SelectedItems(1)
        Else
            ' User canceled
            Exit Sub
        End If
    End With
    
    ' n number prompt
RetryN:
    n = Application.InputBox("N value?" & vbCr & vbCr & "(1 or 2)", "Enter N Value", 1, Type:=1)
    If n = 0 Then Exit Sub      ' User canceled
    If n <> 1 And n <> 2 Then MsgBox "You can only select 1 or 2", vbExclamation, "Invalid Entry": GoTo RetryN
    
    ' define Short Names range
    With Sheets(1)
       Set rngShorts = .Range("N200", .Range("N" & Rows.Count).End(xlUp))
    End With
    
    Application.ScreenUpdating = False
    
    For Each rShortName In rngShorts                                                    ' Loop through each short name in range
       If rShortName.Offset(, 1) = 0 Then                                               ' Test if column O has a zero
           sFile = sPath & "\" & Year(Date) & "_" & n & "_" & rShortName.Text & ".xls"  ' define path and file name
           If Not Dir(sFile, vbDirectory) = vbNullString Then                           ' Test if file exists
                Set wbAnswer = Workbooks.Open(sFile)                                    ' Open Answer workbook
                
                On Error Resume Next
                    Set wsShortName = Nothing                                           ' Reset sheet wsShortName variable
                    Set wsShortName = ThisWorkbook.Sheets(rShortName.Text)              ' set wsShortName to the actual sheet if it exists
                On Error GoTo 0
                If wsShortName Is Nothing Then                                          ' If it doesn't exist, the make a new ShortName worksheet
                    With ThisWorkbook
                        Set wsShortName = .Sheets.Add(After:=.Sheets(.Sheets.Count))
                    End With
                    wsShortName.Name = rShortName.Text                                  ' Name the new sheet
                End If
                
                wbAnswer.Sheets(1).Range("E12:E40").Copy _
                    Destination:=wsShortName.Range("M12:M40")                           ' Copy answers to DataBase
                rShortName.Offset(, 1) = 1                                              ' Set the column O to 1 for the Short Name
                wbAnswer.Close SaveChanges:=False                                       ' Close the Answer workbook
           End If
       End If
    Next rShortName
    
    Application.ScreenUpdating = True

End Sub

 

[PaulS]

That's fast!!
I have to study the code before I can use it in the macro. But I will do!

Other question: Is there a VBA command to trace the execution of the macro statement by statement?

Many thanks for your quick response.

Paul

 

[PaulS]

It works!!
I used the basic flow of the program above. I learned a few new tricks!
After adding some statements for counting the files processed, it worked exactly as I had in mind.
Many thanks!