Consulting

Results 1 to 8 of 8

Thread: Workbook open from specific folder

  1. #1
    VBAX Regular
    Joined
    Apr 2019
    Posts
    17
    Location

    Workbook open from specific folder

    Hi,

    I want to open and save workbook from a specific folder based on H6 cell value or path string.

    The workbook will be opened based on column A values Mango, Lichi, Apple one by one then save and closed accordingly.

    Can someone please help?

    Regards,
    Uday
    Attached Files Attached Files

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi shamim!
    Something like below:
    Sub fileopen()
    Dim pth As String, i As Integer, setting_Sh As Worksheet
    Application.ScreenUpdating = False
    Set setting_Sh = ThisWorkbook.Sheets("Settings")
    With setting_Sh
      pth = .Range("H6").Value
      For i = 1 To .Cells(Rows.Count, 1).End(3).Row
        Workbooks.Open pth & "/" & .Cells(i, 1).Value & ".xlsx"
        'Add processing code here
        ActiveWorkbook.Close True
      Next i
    End With
    Application.ScreenUpdating = True
    End Sub

  3. #3
    VBAX Regular
    Joined
    Apr 2019
    Posts
    17
    Location
    Thanks.

  4. #4
    VBAX Regular
    Joined
    Apr 2019
    Posts
    17
    Location
    Hi,

    I have updated the file with Data tab.

    In Data tab three fruit details are mentioned, I want that Data will be filtered and copy to saved workbook (Mango, Lichi, Apple).

    Step 1 - Open saved workbook
    Step 2 - Filtered the data
    Step 3 - Copy table data from Data tab
    Step 4 - Paste onto saved workbook
    Step 5 - Close the workbook

    Advance thanks
    Uday
    Attached Files Attached Files

  5. #5
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Please refer to the attachment.
    Sub fileopen()
    Dim pth As String, i As Integer, setting_Sh As Worksheet, data_Sh As Worksheet
    Dim arr, d As Object, Fruit$
    Set d = CreateObject("scripting.dictionary")
    Set data_Sh = ThisWorkbook.Sheets("Data")
    With data_Sh
      arr = .[a1].CurrentRegion
      For i = 2 To UBound(arr)
        If Not d.exists(arr(i, 1)) Then
          Set d(arr(i, 1)) = Union(.[a1:b1], .Cells(i, 1).Resize(, 2))
        Else
          Set d(arr(i, 1)) = Union(d(arr(i, 1)), .Cells(i, 1).Resize(, 2))
        End If
      Next i
    End With
    Application.ScreenUpdating = False
    Set setting_Sh = ThisWorkbook.Sheets("Setting")  ' old "Settings" --> new "Setting"
    With setting_Sh
      pth = .Range("H6").Value
      For i = 1 To .Cells(Rows.Count, 1).End(3).Row
        Fruit = .Cells(i, 1).Value
        Workbooks.Open pth & "/" & Fruit & ".xlsx"
        d(Fruit).Copy ActiveWorkbook.Sheets(1).[a1]
        ActiveWorkbook.Close True
      Next i
    End With
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files

  6. #6
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Doing so can save memory.
    Sub fileopen()
    Dim pth As String, i As Integer, setting_Sh As Worksheet, data_Sh As Worksheet
    Dim arr, d As Object, Fruit$
    Set d = CreateObject("scripting.dictionary")
    Set data_Sh = ThisWorkbook.Sheets("Data")
    With data_Sh
      arr = .[a1].CurrentRegion
      For i = 2 To UBound(arr)
        If Not d.exists(arr(i, 1)) Then
          d(arr(i, 1)) = "a1:b1," & Cells(i, 1).Resize(, 2).Address(0, 0)
        Else
          d(arr(i, 1)) = d(arr(i, 1)) & "," & Cells(i, 1).Resize(, 2).Address(0, 0)
        End If
      Next i
    End With
    Application.ScreenUpdating = False
    Set setting_Sh = ThisWorkbook.Sheets("Setting")
    With setting_Sh
      pth = .Range("H6").Value
      For i = 1 To .Cells(Rows.Count, 1).End(3).Row
        Fruit = .Cells(i, 1).Value
        Workbooks.Open pth & "/" & Fruit & ".xlsx"
        data_Sh.Range(d(Fruit)).Copy ActiveWorkbook.Sheets(1).[a1]
        ActiveWorkbook.Close True
      Next i
    End With
    Application.ScreenUpdating = True
    End Sub

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Or simply:

    Sub M_snb()
       Sheet2.Cells(1).CurrentRegion.Columns(1).AdvancedFilter 2, , Sheet2.Cells(1, 5), 1
       sn = Sheet2.Cells(1, 5).CurrentRegion
       Sheet2.Cells(1, 5).CurrentRegion.Offset(1).ClearContents
       
       For j = 2 To UBound(sn)
          Sheet2.Cells(2, 5) = sn(j, 1)
          With Workbooks.Add
             Sheet2.Cells(1).CurrentRegion.AdvancedFilter 2, Sheet2.Cells(1, 5).CurrentRegion, .Sheets(1).Cells(1)
           End With
        Next
    End Sub

  8. #8
    VBAX Regular
    Joined
    Apr 2019
    Posts
    17
    Location
    Thanks for your help. Its really appreciated.

    I am trying to implemented the same logic in new attached file.However I am getting error in Stage 2 macro.

    **"Fruit Variant is picking up nothing while performing the loop for last time.

    I want to include one more condition in the same macro which as follows.

    In Data tab if any of the table does (Blue, Green) has new item type which not included previously. i.e., "Banana" the macro should also create new workbook with data onto same mentioned folder.

    Regards,
    Shamim
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •