Loop Application.GetOpenFilename on MultiSelect:=True

[JaimeMabini]

Hello VBA Guru's,

I need help with my current code. I have a code that takes the file using Application.GetOpenFilename function. My code is working accordingly, But now I want to be able to pick multiple files using Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", title:="Select file", MultiSelect:=True), and loop the job/Macro to all the chosen files. I tried multiple ways of doing this, but cant find the correct combination.

Sub UpdateSheet()

'On Error Resume Next

  Dim f As Range, c As Range
  Dim message
  Dim my_FileName As Variant
  Dim NewName As Variant
  Dim xWB As Workbook
  Dim myVar As Long
  
  'Parameters taken from RDS Converter sheet
  Sheets("RDS Converter").Select
  break = Range("C9").Value
  PathName = Range("C7").Value
  this = Range("C8").Value
  NewPath = Range("C11").Value
  
   'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False
  
  ' Will take the old workbook to convert to new version
  my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", title:="Select file", MultiSelect:=False)
  
  If my_FileName = False Then

  MsgBox "No file was selected"

  Exit Sub 'Exits if no file selected

End If
  
'Start of the main conversion job
  Set wb = Workbooks.Open(filename:=PathName & this)
  
  DoEvents
  
  With wb.Sheets("OKTOP® CONFIGURATOR")
    For Each c In .Range("A1", .Range("A" & Rows.Count).End(3))
    
    myVar = Range("C13").Interior.ColorIndex
    
    'inserts a new column
    Range("E:E").EntireColumn.Insert
    
    'clear formats of new inserted column
    Worksheets("OKTOP® CONFIGURATOR").Range("E:E").ClearFormats
          
        If c.Row > break Then
             'MsgBox ("Row " & break & " Reached")
            GoTo ExitA 'End
            
        Else
         
            Set f = Workbooks.Open(my_FileName).Sheets("OKTOP® CONFIGURATOR").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
                     
            If Not f Is Nothing And c.Offset(, 2).Interior.ColorIndex = myVar Then
            
                f.EntireRow.Copy
                .Range("A" & c.Row).PasteSpecial xlValues
                .Range("E" & c.Row).Value = "Yes"
          
         Else
                .Range("E" & c.Row).Value = "No"
                               
End If

End If

Next

ExitA:

'Save as copy procedure
  NewName = Dir(my_FileName) 'Remove path from full filename
  Workbooks("RDS Converter.xlsm").Activate
  Workbooks(this).SaveCopyAs NewPath & "NEW_" & Left(NewName, Len(NewName) - 14) & this
  Workbooks(this).Close SaveChanges:=False
  
'close all other running applications
For Each xWB In Application.Workbooks

    If Not (xWB Is Application.ActiveWorkbook) Then
        xWB.Close

End If
    
Next

End With

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    
  MsgBox ("Row " & break & " Reached..." & vbCrLf & vbCrLf & "Process Done!")

End Sub

Any help will be highly appreciated. Been working with this for a number of hours now and still struggling to find the working combination.

Thank you in advance.

 

[John_w]

Like this:

    Dim files As Variant, file As Variant
    Dim wb As Workbook
    
    files = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select files", MultiSelect:=True)
    If VarType(files) = vbBoolean Then Exit Sub  'Cancel clicked

    For Each file In files
        Set wb = Workbooks.Open(Filename:=file)
    Next

and include your With wb.Sheets("OKTOP® CONFIGURATOR") .... End With block in the above loop.

 

[JaimeMabini]

Like this:

    Dim files As Variant, file As Variant
    Dim wb As Workbook
   
    files = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select files", MultiSelect:=True)
    If VarType(files) = vbBoolean Then Exit Sub  'Cancel clicked

    For Each file In files
        Set wb = Workbooks.Open(Filename:=file)
    Next

and include your With wb.Sheets("OKTOP® CONFIGURATOR") .... End With block in the above loop.

Hello John,

Thank you for your help. I ended up using this:

my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", title:="Select file", MultiSelect:=True)
  If VarType(my_FileName) = vbBoolean Then Exit Sub

If IsArray(my_FileName) Then
    For i = LBound(my_FileName) To UBound(my_FileName)

Next i

And it works accordingly.

Thank you.