Loop selected workbooks via Broswer

[MarkCBB]

Hi there VBA Pros,

I am currently using some code that imports data from an “Import worksheet” (the import worksheet works in the following way, an invoice workbook is manually opened by the user and the data is selected, and then pasted into the main workbook that has the Import worksheet). The challenge that I am facing is that there are 122 workbooks that the user needs to open and paste the into the import worksheet on the main workbook. Is there a way that all the files can be selected from a browser window, and the code will loop though all the workbooks and paste the data into the import worksheet and then run the code, then close that workbook and move onto the next workbook until all the selected workbooks have been done?

The code also needs to get past this information box that pops up when opening the different workbooks. “The file you are trying to open, 82-1_2011-8490_FFF_Direct_FFF_Run_Gross_to_net_Summary_Report.xls; is in a different format than specified by the file extension. Verify that the file is no corrupted and it from a trusted source before opening the file. Do you want to open the file now?” then select yes.
Here is the code that I use once the data has been pasted into the input worksheet (Import). If needed.

Sub IMPORT_DATA()
'NAMES OF THE DATA TYPES - HEADINGS
Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range, n8 As Range, n9 As Range, n10 As Range, n11 As Range
'DATA RANGE NAMES OF THE DATA
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r6 As Range, r7 As Range, r8 As Range, r9 As Range, r10 As Range, r11 As Range
'VALUES OF THE DATA RANGE NAMES
Dim v1 As Range, v2 As Range, v3 As Range, v4 As Range, v5 As Range, v6 As Range, v7 As Range, v8 As Range, v9 As Range, v10 As Range, v11 As Range
'THIS IS THE NEW LOCATION FOR THE NEW DATA
Dim E1 As Range, E2 As Range, E3 As Range, E4 As Range, E5 As Range
'THESE ARE THE MAIN NAMES OF THE TYPES OF DATA
Dim h1 As Range, h2 As Range
'THIS IS THE NAME OF THE DATA SHEET
Dim M1 As Range

If Range("A5").Value = "" And Range("A6").Value = "" And Range("A7").Value = "" Then
MsgBox ("There is no data")
Exit Sub
Else

Sheets("INPUT").Select
Range("A1").Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Set M1 = Selection
        With M1
        .MergeCells = False
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

        End With
        M1.UnMerge
                     
'SET THE HEADINGS of the MAIN DATA RANGES
    Set h1 = Range("B5")
    Set h2 = Range("B7")
    
'This is for the allocation data
        Set n1 = Cells.Find(What:="Allowances")
        If Not n1 Is Nothing Then
        With n1.Offset(1, -1)
        Set r1 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v1 = r1.Offset(, 2)
        Else
        End If
 
 'This is for the Deductions
        Set n2 = Cells.Find(What:="Deductions")
        If Not n2 Is Nothing Then
        With n2.Offset(1, -1)
        Set r2 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v2 = r2.Offset(, 2)
        Else
        End If
    
'This is for the Involuntary Deductions
        Set n3 = Cells.Find(What:="Involuntary Deductions")
        If Not n3 Is Nothing Then
        With n3.Offset(1, -1)
        Set r3 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v3 = r3.Offset(, 2)
        Else
        End If

'This is for the Lump Sum Amounts
        Set n4 = Cells.Find(What:="Lump Sum Amounts")
        If Not n4 Is Nothing Then
        With n4.Offset(1, -1)
        Set r4 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v4 = r4.Offset(, 2)
        Else
        End If
 
'This is for the Normal Income
        Set n5 = Cells.Find(What:="Normal Income")
        If Not n5 Is Nothing Then
        With n5.Offset(1, -1)
        Set r5 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v5 = r5.Offset(, 2)
        Else
        End If
 
'This is for the Statutory Deductions
        Set n6 = Cells.Find(What:="Statutory Deductions")
        If Not n6 Is Nothing Then
        With n6.Offset(1, -1)
        Set r6 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v6 = r6.Offset(, 2)
        Else
        End If
 
'This is for the Voluntary Deductions
        Set n7 = Cells.Find(What:="Voluntary Deductions")
        If Not n7 Is Nothing Then
        With n7.Offset(1, -1)
        Set r7 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v7 = r7.Offset(, 2)
        Else
        End If
 
'This is for the Employer Contributions
        Set n8 = Cells.Find(What:="Employer Contributions")
        If Not n8 Is Nothing Then
        With n8.Offset(1, -1)
        Set r8 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v8 = r8.Offset(, 2)
        Else
        End If
 
'This is for the Fringe Benefits
        Set n9 = Cells.Find(What:="Fringe Benefits")
        If Not n9 Is Nothing Then
        With n9.Offset(1, -1)
        Set r9 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v9 = r9.Offset(, 2)
        Else
        End If
 
'This is for the Statutory Information
        Set n10 = Cells.Find(What:="Statutory Information")
        If Not n10 Is Nothing Then
        With n10.Offset(1, -1)
        Set r10 = Range(.Cells, .Cells.End(xlDown))
        End With
        Set v10 = r10.Offset(, 2)
        Else
        End If
    
'This is for the Total FNB EFT
On Error Resume Next
    Cells.Find(What:="Total FNB EFT").Select
    If n11 Is Nothing Then
    Else
    Set n11 = Selection
    Columns("C").Replace What:="Count......*", Replacement:=""
    Selection.Offset(, 3).Select
    Selection.FormulaR1C1 = "=SUBSTITUTE(RC[-1],LEFT(RC[-1],3),"""")-0"
    Selection.Copy
    Selection.Offset(, -1).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.Offset(, 1).ClearContents
    Set v11 = Selection
    End If
    On Error GoTo 0
    
'This removes all the the commas so that the text is turned into values
    Columns("C:C").Select
    Selection.Replace What:=",", Replacement:=""
 
Sheets("DATA").Visible = True
Sheets("DATA").Select
'THIS IS THE NEW STARTING POINT FOR THE NEWEST DATA TO BE PASTED
Set E1 = Range("A1048576")
Set E2 = Range("B1048576")
Set E3 = Range("C1048576")
Set E4 = Range("D1048576")
Set E5 = Range("E1048576")
 
'This is the moving of the data from the Input sheets to the Data sheet

If n1 Is Nothing Then
Else
r1.Copy
E4.Select
Call Up
ActiveSheet.Paste
v1.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n1
End If

If n2 Is Nothing Then
Else
r2.Copy
E4.Select
Call Up
ActiveSheet.Paste
v2.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n2
End If

If n3 Is Nothing Then
Else
r3.Copy
E4.Select
Call Up
ActiveSheet.Paste
v3.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n3
End If

If n4 Is Nothing Then
Else
r4.Copy
E4.Select
Call Up
ActiveSheet.Paste
v4.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n4
End If

If n5 Is Nothing Then
Else
r5.Copy
E4.Select
Call Up
ActiveSheet.Paste
v5.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n5
End If

If n6 Is Nothing Then
Else
r6.Copy
E4.Select
Call Up
ActiveSheet.Paste
v6.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n6
End If

If n7 Is Nothing Then
Else
r7.Copy
E4.Select
Call Up
ActiveSheet.Paste
v7.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n7
End If

If n8 Is Nothing Then
Else
r8.Copy
E4.Select
Call Up
ActiveSheet.Paste
v8.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n8
End If

If n9 Is Nothing Then
Else
r9.Copy
E4.Select
Call Up
ActiveSheet.Paste
v9.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n9
End If

If n10 Is Nothing Then
Else
r10.Copy
E4.Select
Call Up
ActiveSheet.Paste
v10.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n10
End If

If n11 Is Nothing Then
Else
E4.Select
Call Up
Selection.FormulaR1C1 = "NUMBER PAID"
v11.Copy
E5.Select
Call Up
ActiveSheet.Paste
E3.Select
Call Up
Selection.Offset(, 1).Select
Selection.Offset(, -1).Select
Selection.FormulaR1C1 = n11
End If

Sheets("DATA").Select
Columns("E").Replace What:="......", Replacement:=""
Columns("D").Replace What:="Total", Replacement:=""
On Error Resume Next
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

E2.Select
Call Up
Selection.Offset(, 1).Select
Range(Selection, Selection.End(xlDown)).Select
If ActiveCell.Value = "" Then
Range("G1").FormulaR1C1 = "X"
Else
Selection.Offset(0, -1).Select
Selection.FormulaR1C1 = h2
Selection.Offset(0, -1).Select
Selection.FormulaR1C1 = h1
End If

M1.ClearContents
Call REMOVE
Range("G1").ClearContents
If Range("F1").Value > 0 Then
MsgBox ("Some data does not look correct in the database, please chack and remove if needed. thanks")
Else
End If
'Sheets("DATA").Visible = False
Sheets("REPORT").Select
ActiveWorkbook.RefreshAll
MsgBox ("Done!")
End If
End Sub
Sub Up()
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
End Sub
Sub REMOVE()
Dim sh As Worksheet
Set sh = Worksheets("DATA")
On Error Resume Next
If Range("G1").Value = "X" Then
Else
rowID = 5
While sh.Cells(rowID, 5) <> ""
    'Remove A to Z
    For i = 65 To 90
           a = Replace(sh.Cells(rowID, 5), Chr(i), "")
           sh.Cells(rowID, 5) = a
    Next i
    'Remove a to z
    For i = 97 To 122
           a = Replace(sh.Cells(rowID, 5), Chr(i), "")
           sh.Cells(rowID, 5) = a
    Next i
    rowID = rowID + 1
Wend
End If
On Error GoTo 0

End Sub

If possible is there a way that an estimated time to completion can appear in a Msgbox, before running the code? (This is just a nice to have)