Handling multiple files in macro

PaulS

Board Regular
Joined
Feb 26, 2006
Messages
66
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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Try something like this...
Code:
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
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,236
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top