PDA

View Full Version : [SOLVED] Workbook open from specific folder



shamim
04-14-2019, 11:09 PM
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

大灰狼1976
04-14-2019, 11:39 PM
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

shamim
04-15-2019, 05:50 AM
Thanks.:bow:

shamim
04-16-2019, 12:55 AM
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

大灰狼1976
04-16-2019, 01:19 AM
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

大灰狼1976
04-16-2019, 01:46 AM
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

snb
04-16-2019, 05:40 AM
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

shamim
04-23-2019, 05:25 AM
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