Open, then auto select file and automatically run program

[kbenjamin827]

Hi Guys,

I am looking for a way to open a folder, and have different workbooks open different files, using a partial title and then run specific programs.

For workbook1 I have this code:

Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim Fnd As Range
Dim Ary As Variant
Dim i As Long

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
Ary = Array("Total", 24, "t-4", 4, "t-3", 5, "t-2", 6, "t-1", 7, "Behr SOP = t0", 8, "t1", 9, "t2", 10, "t3", 11, "t4", 12, "t5", 13, "t6", 14, "t7", 15, "t8", 16, "t9", 17, "t10", 18, "t11", 19, "t12", 20, "t13", 21, "t14", 22, "t15", 23)
    '-------------------------------------------------------------
    'Open file with data to be copied
    
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)
    
    'If Cancel then Exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If
    
    '--------------------------------------------------------------
 'Copy Range
   For i = 0 To UBound(Ary) Step 2
      Set Fnd = wsCopyFrom.Range("5:5").Find(Ary(i), , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         wsCopyFrom.Range(Fnd.Offset(1), wsCopyFrom.Cells(wsCopyFrom.Rows.Count, Fnd.Column).End(xlUp)).Copy
         wsCopyTo.Cells(7, Ary(i + 1)).PasteSpecial xlPasteValues
      End If
   Next i
   Application.CutCopyMode = False
   wbCopyFrom.Close SaveChanges:=False
End Sub

For workobook2 I have this code:

Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet

    '-------------------------------------------------------------
    'Open file with data to be copied
    
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)
    
    'If Cancel then Exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If
    
    '--------------------------------------------------------------
    'Copy Range
    wsCopyFrom.Range("B1:G43").Copy
    wsCopyTo.Range("B4").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    wsCopyFrom.Range("H1:H43").Copy
    wsCopyTo.Range("Q4").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
    wsCopyFrom.Range("I1:N36").Copy
    wsCopyTo.Range("B54").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    wsCopyFrom.Range("O1:O36").Copy
    wsCopyTo.Range("Q54").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
    'Close file that was opened
    wbCopyFrom.Close SaveChanges:=False
End Sub

Workbook 1 should automatically select "option 1" and workbook 2 should automatically select "option 2" and run the codes automatically.

Is this even possible?

 

[kbenjamin827]

Open folder and auto select file

I was able to create a macro that allowed me to select what folder I want to open, so is there a way for the macro to auto select a file, when I open that folder, based on a partial title?

Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet

    '-------------------------------------------------------------
    'Open file with data to be copied
    
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)
    
    'If Cancel then Exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If
End Sub

 

[kbenjamin827]

auto select file

My macro, allows me to choose what folder I want to open, and then select a file. It copys and pastes the information I want from the file to my active workbook.

Is there a way to choose what folder you want to open and the macro chooses which file to open, to copy and paste information from, based on a partial title?

The folder is variable so I have to choose it.

for example the files would look like this:

abc1date
abc2date
abc3date

So the partial title would just be "abc1" or "abc2"

this is the code I have right now:

Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim Fnd As Range
Dim Ary As Variant
Dim i As Long

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
Ary = Array("Total", 24, "t-4", 4, "t-3", 5, "t-2", 6, "t-1", 7, "Behr SOP = t0", 8, "t1", 9, "t2", 10, "t3", 11, "t4", 12, "t5", 13, "t6", 14, "t7", 15, "t8", 16, "t9", 17, "t10", 18, "t11", 19, "t12", 20, "t13", 21, "t14", 22, "t15", 23)
    '-------------------------------------------------------------
    'Open file with data to be copied
    
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)
    
    'If Cancel then Exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If
    
    '--------------------------------------------------------------
 'Copy Range
   For i = 0 To UBound(Ary) Step 2
      Set Fnd = wsCopyFrom.Range("5:5").Find(Ary(i), , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         wsCopyFrom.Range(Fnd.Offset(1), wsCopyFrom.Cells(wsCopyFrom.Rows.Count, Fnd.Column).End(xlUp)).Copy
         wsCopyTo.Cells(7, Ary(i + 1)).PasteSpecial xlPasteValues
      End If
   Next i
   Application.CutCopyMode = False
   wbCopyFrom.Close SaveChanges:=False
End Sub

https://www.excelforum.com/excel-programming-vba-macros/1238483-auto-select-file.html#post4939047

There are some idea here.